|
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 Card0130. ST1344.2
004100 OBJECT-COMPUTER. ST1344.2
004200 Card0131. ST1344.2
004300 INPUT-OUTPUT SECTION. ST1344.2
004400 FILE-CONTROL. ST1344.2
004500 SELECT PRINT-FILE ASSIGN TO ST1344.2
004600 "C0085" . ST1344.2
004700 SELECT SORTFILE-2D ASSIGN TO ST1344.2
004800 "C0039" . ST1344.2
004900 SELECT SORTIN-2D ASSIGN TO ST1344.2
005000 "C0001" . ST1344.2
005100 SELECT SORTOUT-2D ASSIGN TO ST1344.2
005200 "C0002" . 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
007000 VALUE OF ST1344.2
007100 Impl1 ST1344.2
007200 IS ST1344.2
007300 4711 ST1344.2
007400 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
008200 VALUE OF ST1344.2
008300 Impl1 ST1344.2
008400 IS ST1344.2
008500 4711 ST1344.2
008600 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
031300 EXIT PROGRAM. ST1344.2
031400 TERMINATE-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
037700 IF RECORD-COUNT GREATER 42 ST1344.2
037800 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1344.2
037900 MOVE SPACE TO DUMMY-RECORD ST1344.2
038000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1344.2
038100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1344.2
038200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1344.2
038300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1344.2
038400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1344.2
038500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1344.2
038600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1344.2
038700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1344.2
038800 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1344.2
038900 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
055000 IF RECORD-COUNT GREATER 50 ST1344.2
055100 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1344.2
055200 MOVE SPACE TO DUMMY-RECORD ST1344.2
055300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1344.2
055400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1344.2
055500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1344.2
055600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1344.2
055700 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1344.2
055800 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
¤ Dauer der Verarbeitung: 0.124 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
