Impressum ix107a.cob   Sprache: Cobol

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     Card0130.                                                    IX1074.2
008600 OBJECT-COMPUTER.                                                 IX1074.2
008700     Card0131.                                                    IX1074.2
008800 INPUT-OUTPUT SECTION.                                            IX1074.2
008900 FILE-CONTROL.                                                    IX1074.2
009000     SELECT RAW-DATA   ASSIGN TO                                  IX1074.2
009100     "C0098"                                                      IX1074.2
009200            ORGANIZATION IS INDEXED                               IX1074.2
009300            ACCESS MODE IS RANDOM                                 IX1074.2
009400            RECORD KEY IS RAW-DATA-KEY.                           IX1074.2
009500     SELECT PRINT-FILE ASSIGN TO                                  IX1074.2
009600     "C0085" .                                                    IX1074.2
009700     SELECT IX-FS1 ASSIGN TO                                      IX1074.2
009800     "C0036"                                                      IX1074.2
009900     "C0068"                                                      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     "C0037"                                                      IX1074.2
010500     "C0069"                                                      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
011300                                                                  IX1074.2
011400 FD  RAW-DATA.                                                    IX1074.2
011500                                                                  IX1074.2
011600 01  RAW-DATA-SATZ.                                               IX1074.2
011700     05  RAW-DATA-KEY        PIC X(6).                            IX1074.2
011800     05  C-DATE              PIC 9(6).                            IX1074.2
011900     05  C-TIME              PIC 9(8).                            IX1074.2
012000     05  C-NO-OF-TESTS       PIC 99.                              IX1074.2
012100     05  C-OK                PIC 999.                             IX1074.2
012200     05  C-ALL               PIC 999.                             IX1074.2
012300     05  C-FAIL              PIC 999.                             IX1074.2
012400     05  C-DELETED           PIC 999.                             IX1074.2
012500     05  C-INSPECT           PIC 999.                             IX1074.2
012600     05  C-NOTE              PIC X(13).                           IX1074.2
012700     05  C-INDENT            PIC X.                               IX1074.2
012800     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
013300     LABEL RECORD IS STANDARD                                     IX1074.2
013400     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
014300         10 FILLER         PIC X(24).                             IX1074.2
014400     05 FILLER             PIC X(24).                             IX1074.2
014500     05 FILLER           PIC X(83).                               IX1074.2
014600 FD  IX-FD2                                                       IX1074.2
014700     LABEL RECORD IS STANDARD                                     IX1074.2
014800     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
015700         10 FILLER         PIC X(24).                             IX1074.2
015800     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
016300     03 WRK-XN-24V00-001 PIC X(24)  VALUE                         IX1074.2
016400         "123456789012345678901234".                              IX1074.2
016500 01  WRK-FD2-RECKEY.                                              IX1074.2
016600     03 WRK-DU-05V00-002 PIC 9(5)   VALUE ZERO.                   IX1074.2
016700     03 WRK-XN-24V00-002 PIC X(24)  VALUE                         IX1074.2
016800         "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
037100     OPEN I-O RAW-DATA.                                           IX1074.2
037200     MOVE CCVS-PGM-ID TO RAW-DATA-KEY.                            IX1074.2
037300     READ RAW-DATA INVALID KEY GO TO END-E-1.                     IX1074.2
037400     MOVE "ABORTED " TO C-ABORT.                                  IX1074.2
037500     ADD 1 TO C-NO-OF-TESTS.                                      IX1074.2
037600     ACCEPT C-DATE  FROM DATE.                                    IX1074.2
037700     ACCEPT C-TIME  FROM TIME.                                    IX1074.2
037800     REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1.             IX1074.2
037900 END-E-1.                                                         IX1074.2
038000     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
039400     OPEN I-O RAW-DATA.                                           IX1074.2
039500     MOVE CCVS-PGM-ID TO RAW-DATA-KEY.                            IX1074.2
039600     READ RAW-DATA INVALID KEY GO TO END-E-2.                     IX1074.2
039700     MOVE "OK. " TO C-ABORT.                                  IX1074.2
039800     MOVE PASS-COUNTER TO C-OK.                                   IX1074.2
039900     MOVE ERROR-HOLD   TO C-ALL.                                  IX1074.2
040000     MOVE ERROR-COUNTER TO C-FAIL.                                IX1074.2
040100     MOVE DELETE-COUNTER TO C-DELETED.                            IX1074.2
040200     MOVE INSPECT-COUNTER TO C-INSPECT.                           IX1074.2
040300     REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2.             IX1074.2
040400 END-E-2.                                                         IX1074.2
040500     CLOSE RAW-DATA.                                              IX1074.2
040600     PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE.   IX1074.2
040700 TERMINATE-CCVS.                                                  IX1074.2
040800     EXIT PROGRAM.                                                IX1074.2
040900 TERMINATE-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
047200     IF RECORD-COUNT GREATER 42                                   IX1074.2
047300         MOVE DUMMY-RECORD TO DUMMY-HOLD                          IX1074.2
047400         MOVE SPACE TO DUMMY-RECORD                               IX1074.2
047500         WRITE DUMMY-RECORD AFTER ADVANCING PAGE                  IX1074.2
047600         MOVE CCVS-H-1  TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES    IX1074.2
047700         MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES    IX1074.2
047800         MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES    IX1074.2
047900         MOVE CCVS-H-3  TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES    IX1074.2
048000         MOVE CCVS-C-1  TO DUMMY-RECORD PERFORM WRT-LN            IX1074.2
048100         MOVE CCVS-C-2  TO DUMMY-RECORD PERFORM WRT-LN            IX1074.2
048200         MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN          IX1074.2
048300         MOVE DUMMY-HOLD TO DUMMY-RECORD                          IX1074.2
048400         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
--> --------------------

--> maximum size reached

--> --------------------