|
000100 IDENTIFICATION DIVISION. ST1174.2
000200 PROGRAM-ID. ST1174.2
000300 ST117A. ST1174.2
000400**************************************************************** ST1174.2
000500* * ST1174.2
000600* VALIDATION FOR:- * ST1174.2
000700* * ST1174.2
000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2
000900* * ST1174.2
001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1174.2
001100* * ST1174.2
001200**************************************************************** ST1174.2
001300* * ST1174.2
001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1174.2
001500* * ST1174.2
001600* X-55 - SYSTEM PRINTER NAME. * ST1174.2
001700* X-82 - SOURCE COMPUTER NAME. * ST1174.2
001800* X-83 - OBJECT COMPUTER NAME. * ST1174.2
001900* * ST1174.2
002000**************************************************************** ST1174.2
002100* ST1174.2
002200* ST1174.2
002300* ST117 ST1174.2
002400* ST1174.2
002500* ST1174.2
002600* OBJECTIVE - ST1174.2
002700* ROUTINE ST117 CHECKS THE FILE ( SQ-FS2 ) WHICH IS GIVEN ST1174.2
002800* BY THE SORT IN ST116. THE ALPHANUMERIC KEYS AND NUMERIC KEYSST1174.2
002900* ARE BOTH CHECKED BY ST117. ST1174.2
003000* ST1174.2
003100* ST1174.2
003200* FEATURES TESTED - ST1174.2
003300* * FIXED LENGTH RECORDS ST1174.2
003400* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1174.2
003500* ST1174.2
003600* ST1174.2
003700* ST1174.2
003800* ANSI X3.23-1974 REFERENCES - ST1174.2
003900* * SECTION 4.4 THE SORT STATEMENT PAGE VII-14 ST1174.2
004000* ST1174.2
004100* ST1174.2
004200* FILES USED - ST1174.2
004300* * FILE SQ-FS2 CAN BE ON MAGNETIC TAPE OR MASS-STORAGE. ST1174.2
004400* ST1174.2
004500* SQ-FS2 - ST1174.2
004600* NUMBER OF RECORDS IS SET IN X-65 ST1174.2
004700* FIXED LENGTH ( 507 CHARACTERS PER RECORD ) ST1174.2
004800* BLOCKED 2 ST1174.2
004900* RESERVE 4 AREAS ST1174.2
005000* ST1174.2
005100* ST1174.2
005200* X-CARDS USED - ST1174.2
005300* X-XXXD02 SQ-FS2 ST1174.2
005400* X-XXX063 NATIVE COLLATING SEQUENCE ASCENDING ORDER (NOTE ST1174.2
005500* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-63 ST1174.2
005600* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1174.2
005700* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1174.2
005800* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1174.2
005900* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-63 CARD..... ST1174.2
006000* ST1174.2
006100* X-63 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1174.2
006200* ST1174.2
006300* X-XXX065 4 DIGIT INTEGER FOR THE NUMBER OF RECORDS IN ST1174.2
006400* THE FILE SQ-FS2. ST1174.2
006500* ST1174.2
006600* ST1174.2
006700* OPTIONS RECOMMENDED - ST1174.2
006800* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1174.2
006900* FILE SQ-FS2. ST1174.2
007000* ST1174.2
007100* ST1174.2
007200* TEST DESCRIPTIONS - ST1174.2
007300* THE INTEGER X-65 IS DIVIDED BY 51. THIS IS THE NUMBER ST1174.2
007400* OF DUPLICATE RECORD KEYS THAT ARE EXPECTED IN SQ-FS2. THESE ST1174.2
007500* KEYS SHOULD BE THE LOWEST CHARACTER IN THE NATIVE COLLATING ST1174.2
007600* SEQUENCE. ALL OF THE NUMERIC KEYS FOR THESE RECORDS SHOULD ST1174.2
007700* BE IN ASCENDING ORDER. ST1174.2
007800* ST1174.2
007900* ST1174.2
008000* ************************************************************ ST1174.2
008100 ENVIRONMENT DIVISION. ST1174.2
008200 CONFIGURATION SECTION. ST1174.2
008300 SOURCE-COMPUTER. ST1174.2
008400 Card0130. ST1174.2
008500 OBJECT-COMPUTER. ST1174.2
008600 Card0131. ST1174.2
008700 INPUT-OUTPUT SECTION. ST1174.2
008800 FILE-CONTROL. ST1174.2
008900 SELECT PRINT-FILE ASSIGN TO ST1174.2
009000 "C0085" . ST1174.2
009100 SELECT SQ-FS2 ASSIGN TO ST1174.2
009200 XXXXD002 ST1174.2
009300 ORGANIZATION IS SEQUENTIAL ST1174.2
009400 ACCESS MODE IS SEQUENTIAL. ST1174.2
009500 DATA DIVISION. ST1174.2
009600 FILE SECTION. ST1174.2
009700 FD PRINT-FILE. ST1174.2
009800 01 PRINT-REC PICTURE X(120). ST1174.2
009900 01 DUMMY-RECORD PICTURE X(120). ST1174.2
010000 FD SQ-FS2 ST1174.2
010100 LABEL RECORDS STANDARD ST1174.2
010200 VALUE OF ST1174.2
010300 Impl1 ST1174.2
010400 IS ST1174.2
010500 4711 ST1174.2
010600 ST1174.2
010700 BLOCK CONTAINS 2 RECORDS ST1174.2
010800 RECORD CONTAINS 507 CHARACTERS ST1174.2
010900 DATA RECORD SQ-FS2R1-F-G-507. ST1174.2
011000 01 SQ-FS2R1-F-G-507. ST1174.2
011100 10 REC-PRE-2 PIC X(120). ST1174.2
011200 10 LENGTH-2 PIC 999. ST1174.2
011300 10 THOSE-LOVABLE-KEYS. ST1174.2
011400 20 KEY-4. ST1174.2
011500 30 ALPHAN-KEY-K4 PIC X. ST1174.2
011600 30 NUM-KEY-K4 PIC 999. ST1174.2
011700 20 KEY-5. ST1174.2
011800 30 ALPHAN-KEY-K5 PIC X. ST1174.2
011900 30 NUM-KEY-K5 PIC 999. ST1174.2
012000 20 KEY-6. ST1174.2
012100 30 ALPHAN-KEY-K6 PIC X. ST1174.2
012200 30 NUM-KEY-K6 PIC 999. ST1174.2
012300 10 STUFF-FOR-FUN OCCURS ST1174.2
012400 31 TIMES. ST1174.2
012500 30 FILLER PIC X(12). ST1174.2
012600 WORKING-STORAGE SECTION. ST1174.2
012700 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1174.2
012800 77 WRK-DU-9-2 PIC 9 VALUE 0. ST1174.2
012900 77 WRK-DU-999-0001 PIC 999. ST1174.2
013000 77 WRK-DU-999-2 PIC 999 VALUE 000. ST1174.2
013100 77 WRK-DU-999-3 PIC 999 VALUE ZERO. ST1174.2
013200 77 NUMBER-OF-SETS PIC 999 VALUE ZERO. ST1174.2
013300 77 COUNT-OF-RECS PIC 9(6) VALUE ZERO. ST1174.2
013400 01 WRK-XN-2 PIC X(51) VALUE ST1174.2
013500 " * G BAIRD, USNAVY ". ST1174.2
013600 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1174.2
013700 02 ANSWER PIC X OCCURS 51 TIMES. ST1174.2
013800 01 FILE-RECORD-INFORMATION-REC. ST1174.2
013900 03 FILE-RECORD-INFO-SKELETON. ST1174.2
014000 05 FILLER PICTURE X(48) VALUE ST1174.2
014100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1174.2
014200 05 FILLER PICTURE X(46) VALUE ST1174.2
014300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1174.2
014400 05 FILLER PICTURE X(26) VALUE ST1174.2
014500 ",LFIL=000000,ORG= ,LBLR= ". ST1174.2
014600 05 FILLER PICTURE X(37) VALUE ST1174.2
014700 ",RECKEY= ". ST1174.2
014800 05 FILLER PICTURE X(38) VALUE ST1174.2
014900 ",ALTKEY1= ". ST1174.2
015000 05 FILLER PICTURE X(38) VALUE ST1174.2
015100 ",ALTKEY2= ". ST1174.2
015200 05 FILLER PICTURE X(7) VALUE SPACE.ST1174.2
015300 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1174.2
015400 05 FILE-RECORD-INFO-P1-120. ST1174.2
015500 07 FILLER PIC X(5). ST1174.2
015600 07 XFILE-NAME PIC X(6). ST1174.2
015700 07 FILLER PIC X(8). ST1174.2
015800 07 XRECORD-NAME PIC X(6). ST1174.2
015900 07 FILLER PIC X(1). ST1174.2
016000 07 REELUNIT-NUMBER PIC 9(1). ST1174.2
016100 07 FILLER PIC X(7). ST1174.2
016200 07 XRECORD-NUMBER PIC 9(6). ST1174.2
016300 07 FILLER PIC X(6). ST1174.2
016400 07 UPDATE-NUMBER PIC 9(2). ST1174.2
016500 07 FILLER PIC X(5). ST1174.2
016600 07 ODO-NUMBER PIC 9(4). ST1174.2
016700 07 FILLER PIC X(5). ST1174.2
016800 07 XPROGRAM-NAME PIC X(5). ST1174.2
016900 07 FILLER PIC X(7). ST1174.2
017000 07 XRECORD-LENGTH PIC 9(6). ST1174.2
017100 07 FILLER PIC X(7). ST1174.2
017200 07 CHARS-OR-RECORDS PIC X(2). ST1174.2
017300 07 FILLER PIC X(1). ST1174.2
017400 07 XBLOCK-SIZE PIC 9(4). ST1174.2
017500 07 FILLER PIC X(6). ST1174.2
017600 07 RECORDS-IN-FILE PIC 9(6). ST1174.2
017700 07 FILLER PIC X(5). ST1174.2
017800 07 XFILE-ORGANIZATION PIC X(2). ST1174.2
017900 07 FILLER PIC X(6). ST1174.2
018000 07 XLABEL-TYPE PIC X(1). ST1174.2
018100 05 FILE-RECORD-INFO-P121-240. ST1174.2
018200 07 FILLER PIC X(8). ST1174.2
018300 07 XRECORD-KEY PIC X(29). ST1174.2
018400 07 FILLER PIC X(9). ST1174.2
018500 07 ALTERNATE-KEY1 PIC X(29). ST1174.2
018600 07 FILLER PIC X(9). ST1174.2
018700 07 ALTERNATE-KEY2 PIC X(29). ST1174.2
018800 07 FILLER PIC X(7). ST1174.2
018900 01 TEST-RESULTS. ST1174.2
019000 02 FILLER PIC X VALUE SPACE. ST1174.2
019100 02 FEATURE PIC X(20) VALUE SPACE. ST1174.2
019200 02 FILLER PIC X VALUE SPACE. ST1174.2
019300 02 P-OR-F PIC X(5) VALUE SPACE. ST1174.2
019400 02 FILLER PIC X VALUE SPACE. ST1174.2
019500 02 PAR-NAME. ST1174.2
019600 03 FILLER PIC X(19) VALUE SPACE. ST1174.2
019700 03 PARDOT-X PIC X VALUE SPACE. ST1174.2
019800 03 DOTVALUE PIC 99 VALUE ZERO. ST1174.2
019900 02 FILLER PIC X(8) VALUE SPACE. ST1174.2
020000 02 RE-MARK PIC X(61). ST1174.2
020100 01 TEST-COMPUTED. ST1174.2
020200 02 FILLER PIC X(30) VALUE SPACE. ST1174.2
020300 02 FILLER PIC X(17) VALUE ST1174.2
020400 " COMPUTED=". ST1174.2
020500 02 COMPUTED-X. ST1174.2
020600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1174.2
020700 03 COMPUTED-N REDEFINES COMPUTED-A ST1174.2
020800 PIC -9(9).9(9). ST1174.2
020900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1174.2
021000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1174.2
021100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1174.2
021200 03 CM-18V0 REDEFINES COMPUTED-A. ST1174.2
021300 04 COMPUTED-18V0 PIC -9(18). ST1174.2
021400 04 FILLER PIC X. ST1174.2
021500 03 FILLER PIC X(50) VALUE SPACE. ST1174.2
021600 01 TEST-CORRECT. ST1174.2
021700 02 FILLER PIC X(30) VALUE SPACE. ST1174.2
021800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1174.2
021900 02 CORRECT-X. ST1174.2
022000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1174.2
022100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1174.2
022200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1174.2
022300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1174.2
022400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1174.2
022500 03 CR-18V0 REDEFINES CORRECT-A. ST1174.2
022600 04 CORRECT-18V0 PIC -9(18). ST1174.2
022700 04 FILLER PIC X. ST1174.2
022800 03 FILLER PIC X(2) VALUE SPACE. ST1174.2
022900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1174.2
023000 01 CCVS-C-1. ST1174.2
023100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1174.2
023200- "SS PARAGRAPH-NAME ST1174.2
023300- " REMARKS". ST1174.2
023400 02 FILLER PIC X(20) VALUE SPACE. ST1174.2
023500 01 CCVS-C-2. ST1174.2
023600 02 FILLER PIC X VALUE SPACE. ST1174.2
023700 02 FILLER PIC X(6) VALUE "TESTED". ST1174.2
023800 02 FILLER PIC X(15) VALUE SPACE. ST1174.2
023900 02 FILLER PIC X(4) VALUE "FAIL". ST1174.2
024000 02 FILLER PIC X(94) VALUE SPACE. ST1174.2
024100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1174.2
024200 01 REC-CT PIC 99 VALUE ZERO. ST1174.2
024300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1174.2
024400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1174.2
024500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1174.2
024600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1174.2
024700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1174.2
024800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1174.2
024900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1174.2
025000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1174.2
025100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1174.2
025200 01 CCVS-H-1. ST1174.2
025300 02 FILLER PIC X(39) VALUE SPACES. ST1174.2
025400 02 FILLER PIC X(42) VALUE ST1174.2
025500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1174.2
025600 02 FILLER PIC X(39) VALUE SPACES. ST1174.2
025700 01 CCVS-H-2A. ST1174.2
025800 02 FILLER PIC X(40) VALUE SPACE. ST1174.2
025900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1174.2
026000 02 FILLER PIC XXXX VALUE ST1174.2
026100 "4.2 ". ST1174.2
026200 02 FILLER PIC X(28) VALUE ST1174.2
026300 " COPY - NOT FOR DISTRIBUTION". ST1174.2
026400 02 FILLER PIC X(41) VALUE SPACE. ST1174.2
026500 ST1174.2
026600 01 CCVS-H-2B. ST1174.2
026700 02 FILLER PIC X(15) VALUE ST1174.2
026800 "TEST RESULT OF ". ST1174.2
026900 02 TEST-ID PIC X(9). ST1174.2
027000 02 FILLER PIC X(4) VALUE ST1174.2
027100 " IN ". ST1174.2
027200 02 FILLER PIC X(12) VALUE ST1174.2
027300 " HIGH ". ST1174.2
027400 02 FILLER PIC X(22) VALUE ST1174.2
027500 " LEVEL VALIDATION FOR ". ST1174.2
027600 02 FILLER PIC X(58) VALUE ST1174.2
027700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2
027800 01 CCVS-H-3. ST1174.2
027900 02 FILLER PIC X(34) VALUE ST1174.2
028000 " FOR OFFICIAL USE ONLY ". ST1174.2
028100 02 FILLER PIC X(58) VALUE ST1174.2
028200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1174.2
028300 02 FILLER PIC X(28) VALUE ST1174.2
028400 " COPYRIGHT 1985 ". ST1174.2
028500 01 CCVS-E-1. ST1174.2
028600 02 FILLER PIC X(52) VALUE SPACE. ST1174.2
028700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1174.2
028800 02 ID-AGAIN PIC X(9). ST1174.2
028900 02 FILLER PIC X(45) VALUE SPACES. ST1174.2
029000 01 CCVS-E-2. ST1174.2
029100 02 FILLER PIC X(31) VALUE SPACE. ST1174.2
029200 02 FILLER PIC X(21) VALUE SPACE. ST1174.2
029300 02 CCVS-E-2-2. ST1174.2
029400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1174.2
029500 03 FILLER PIC X VALUE SPACE. ST1174.2
029600 03 ENDER-DESC PIC X(44) VALUE ST1174.2
029700 "ERRORS ENCOUNTERED". ST1174.2
029800 01 CCVS-E-3. ST1174.2
029900 02 FILLER PIC X(22) VALUE ST1174.2
030000 " FOR OFFICIAL USE ONLY". ST1174.2
030100 02 FILLER PIC X(12) VALUE SPACE. ST1174.2
030200 02 FILLER PIC X(58) VALUE ST1174.2
030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2
030400 02 FILLER PIC X(13) VALUE SPACE. ST1174.2
030500 02 FILLER PIC X(15) VALUE ST1174.2
030600 " COPYRIGHT 1985". ST1174.2
030700 01 CCVS-E-4. ST1174.2
030800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1174.2
030900 02 FILLER PIC X(4) VALUE " OF ". ST1174.2
031000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1174.2
031100 02 FILLER PIC X(40) VALUE ST1174.2
031200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1174.2
031300 01 XXINFO. ST1174.2
031400 02 FILLER PIC X(19) VALUE ST1174.2
031500 "*** INFORMATION ***". ST1174.2
031600 02 INFO-TEXT. ST1174.2
031700 04 FILLER PIC X(8) VALUE SPACE. ST1174.2
031800 04 XXCOMPUTED PIC X(20). ST1174.2
031900 04 FILLER PIC X(5) VALUE SPACE. ST1174.2
032000 04 XXCORRECT PIC X(20). ST1174.2
032100 02 INF-ANSI-REFERENCE PIC X(48). ST1174.2
032200 01 HYPHEN-LINE. ST1174.2
032300 02 FILLER PIC IS X VALUE IS SPACE. ST1174.2
032400 02 FILLER PIC IS X(65) VALUE IS "************************ST1174.2
032500- "*****************************************". ST1174.2
032600 02 FILLER PIC IS X(54) VALUE IS "************************ST1174.2
032700- "******************************". ST1174.2
032800 01 CCVS-PGM-ID PIC X(9) VALUE ST1174.2
032900 "ST117A". ST1174.2
033000 PROCEDURE DIVISION. ST1174.2
033100 CCVS1 SECTION. ST1174.2
033200 OPEN-FILES. ST1174.2
033300 OPEN OUTPUT PRINT-FILE. ST1174.2
033400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1174.2
033500 MOVE SPACE TO TEST-RESULTS. ST1174.2
033600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1174.2
033700 MOVE ZERO TO REC-SKL-SUB. ST1174.2
033800 PERFORM CCVS-INIT-FILE 9 TIMES. ST1174.2
033900 CCVS-INIT-FILE. ST1174.2
034000 ADD 1 TO REC-SKL-SUB. ST1174.2
034100 MOVE FILE-RECORD-INFO-SKELETON ST1174.2
034200 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1174.2
034300 CCVS-INIT-EXIT. ST1174.2
034400 GO TO CCVS1-EXIT. ST1174.2
034500 CLOSE-FILES. ST1174.2
034600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1174.2
034700 TERMINATE-CCVS. ST1174.2
034800 EXIT PROGRAM. ST1174.2
034900 TERMINATE-CALL. ST1174.2
035000 STOP RUN. ST1174.2
035100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1174.2
035200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1174.2
035300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1174.2
035400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1174.2
035500 MOVE "****TEST DELETED****" TO RE-MARK. ST1174.2
035600 PRINT-DETAIL. ST1174.2
035700 IF REC-CT NOT EQUAL TO ZERO ST1174.2
035800 MOVE "." TO PARDOT-X ST1174.2
035900 MOVE REC-CT TO DOTVALUE. ST1174.2
036000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1174.2
036100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1174.2
036200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1174.2
036300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1174.2
036400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1174.2
036500 MOVE SPACE TO CORRECT-X. ST1174.2
036600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1174.2
036700 MOVE SPACE TO RE-MARK. ST1174.2
036800 HEAD-ROUTINE. ST1174.2
036900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2
037000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2
037100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1174.2
037200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1174.2
037300 COLUMN-NAMES-ROUTINE. ST1174.2
037400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2
037500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2
037600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2
037700 END-ROUTINE. ST1174.2
037800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1174.2
037900 END-RTN-EXIT. ST1174.2
038000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2
038100 END-ROUTINE-1. ST1174.2
038200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1174.2
038300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1174.2
038400 ADD PASS-COUNTER TO ERROR-HOLD. ST1174.2
038500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1174.2
038600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1174.2
038700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1174.2
038800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1174.2
038900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1174.2
039000 END-ROUTINE-12. ST1174.2
039100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1174.2
039200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1174.2
039300 MOVE "NO " TO ERROR-TOTAL ST1174.2
039400 ELSE ST1174.2
039500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1174.2
039600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1174.2
039700 PERFORM WRITE-LINE. ST1174.2
039800 END-ROUTINE-13. ST1174.2
039900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1174.2
040000 MOVE "NO " TO ERROR-TOTAL ELSE ST1174.2
040100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1174.2
040200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1174.2
040300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2
040400 IF INSPECT-COUNTER EQUAL TO ZERO ST1174.2
040500 MOVE "NO " TO ERROR-TOTAL ST1174.2
040600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1174.2
040700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1174.2
040800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2
040900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2
041000 WRITE-LINE. ST1174.2
041100 ADD 1 TO RECORD-COUNT. ST1174.2
041200 IF RECORD-COUNT GREATER 42 ST1174.2
041300 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1174.2
041400 MOVE SPACE TO DUMMY-RECORD ST1174.2
041500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1174.2
041600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1174.2
041700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1174.2
041800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1174.2
041900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1174.2
042000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1174.2
042100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1174.2
042200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1174.2
042300 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1174.2
042400 MOVE ZERO TO RECORD-COUNT. ST1174.2
042500 PERFORM WRT-LN. ST1174.2
042600 WRT-LN. ST1174.2
042700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2
042800 MOVE SPACE TO DUMMY-RECORD. ST1174.2
042900 BLANK-LINE-PRINT. ST1174.2
043000 PERFORM WRT-LN. ST1174.2
043100 FAIL-ROUTINE. ST1174.2
043200 IF COMPUTED-X NOT EQUAL TO SPACE ST1174.2
043300 GO TO FAIL-ROUTINE-WRITE. ST1174.2
043400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1174.2
043500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1174.2
043600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1174.2
043700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2
043800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1174.2
043900 GO TO FAIL-ROUTINE-EX. ST1174.2
044000 FAIL-ROUTINE-WRITE. ST1174.2
044100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1174.2
044200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1174.2
044300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1174.2
044400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1174.2
044500 FAIL-ROUTINE-EX. EXIT. ST1174.2
044600 BAIL-OUT. ST1174.2
044700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1174.2
044800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1174.2
044900 BAIL-OUT-WRITE. ST1174.2
045000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1174.2
045100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1174.2
045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2
045300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1174.2
045400 BAIL-OUT-EX. EXIT. ST1174.2
045500 CCVS1-EXIT. ST1174.2
045600 EXIT. ST1174.2
045700 SECT-ST117-0001 SECTION. ST1174.2
045800 SRT-INIT. ST1174.2
045900 OPEN INPUT SQ-FS2. ST1174.2
046000 MOVE "BIG-SORT" TO PAR-NAME. ST1174.2
046100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1174.2
046200 MOVE 0 TO WRK-DU-9-0001. ST1174.2
046300 MOVE 0 TO WRK-DU-9-2. ST1174.2
046400 MOVE 0 TO WRK-DU-999-3. ST1174.2
046500 DIVIDE ST1174.2
046600 Card0101 ST1174.2
046700 BY 51 GIVING NUMBER-OF-SETS. ST1174.2
046800* ST1174.2
046900* FOR EVERY SET OF 51 RECORDS CREATED AS THE ORIGINAL INPUT ST1174.2
047000* FILE FOR THE SORT ( X-65 / 51 ), THEN THERE SHOULD BE AT ST1174.2
047100* LEAST THAT NUMBER OF DUPLICATE ALPHANUMERIC KEYS AS THE ST1174.2
047200* FIRST N RECORDS IN THE SORTED FILE SQ-FS2. THAT MANY ST1174.2
047300* RECORDS WILL BE READ AND THE KEYS SHOULD BE THE LOWEST ST1174.2
047400* CHARACTER IN THE NATIVE COLLATING SEQUENCE. THE NUMERIC ST1174.2
047500* KEYS SHOULD ALWAYS BE ASCENDING. ST1174.2
047600* ST1174.2
047700 MOVE 1 TO WRK-DU-999-0001. ST1174.2
047800 SRT-INIT-01. ST1174.2
047900 PERFORM RD-2 THRU R2-EXIT. ST1174.2
048000 ADD 1 TO WRK-DU-999-0001. ST1174.2
048100 IF WRK-DU-999-0001 IS NOT GREATER THAN NUMBER-OF-SETS ST1174.2
048200 GO TO SRT-INIT-01. ST1174.2
048300 IF WRK-DU-9-2 IS EQUAL TO 0 ST1174.2
048400 PERFORM PASS ST1174.2
048500 GO TO SRT-WRITE ST1174.2
048600 ELSE ST1174.2
048700 PERFORM FAIL ST1174.2
048800 MOVE "ERROR AT RECORD" TO COMPUTED-A ST1174.2
048900 MOVE WRK-DU-999-2 TO CORRECT-18V0 ST1174.2
049000 MOVE "FILE SQ-FS2 PASSED FROM ST116" TO RE-MARK ST1174.2
049100 GO TO SRT-WRITE. ST1174.2
049200 SRT-DELETE. ST1174.2
049300 PERFORM DE-LETE. ST1174.2
049400 SRT-WRITE. ST1174.2
049500 PERFORM PRINT-DETAIL. ST1174.2
049600 CLOSE SQ-FS2. ST1174.2
049700 GO TO ST117-END. ST1174.2
049800 RD-2. ST1174.2
049900 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1174.2
050000 GO TO R2-EXIT. ST1174.2
050100 READ SQ-FS2 AT END GO TO PREMATURE-EOF. ST1174.2
050200 IF ALPHAN-KEY-K6 IS NOT EQUAL TO ANSWER (1) ST1174.2
050300 MOVE 1 TO WRK-DU-9-2 ST1174.2
050400 MOVE WRK-DU-999-0001 TO WRK-DU-999-2 ST1174.2
050500 MOVE 1 TO WRK-DU-9-0001. ST1174.2
050600 IF NUM-KEY-K6 IS NOT GREATER THAN WRK-DU-999-3 ST1174.2
050700 MOVE 1 TO WRK-DU-9-2 ST1174.2
050800 MOVE WRK-DU-999-0001 TO WRK-DU-999-2 ST1174.2
050900 MOVE 1 TO WRK-DU-9-0001 ST1174.2
051000 ELSE ST1174.2
051100 MOVE NUM-KEY-K6 TO WRK-DU-999-3 ST1174.2
051200 GO TO R2-EXIT. ST1174.2
051300 PREMATURE-EOF. ST1174.2
051400 MOVE 1 TO WRK-DU-9-0001. ST1174.2
051500 PERFORM FAIL. ST1174.2
051600 MOVE "AT RECORD" TO COMPUTED-A. ST1174.2
051700 MOVE WRK-DU-999-0001 TO CORRECT-18V0. ST1174.2
051800 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1174.2
051900 R2-EXIT. ST1174.2
052000 EXIT. ST1174.2
052100 ST117-END. ST1174.2
052200 EXIT. ST1174.2
052300 FILEDUMP SECTION. ST1174.2
052400 FILE-2-DUMP-INIT. ST1174.2
052500 OPEN INPUT SQ-FS2. ST1174.2
052600 MOVE ZERO TO COUNT-OF-RECS. ST1174.2
052700 FILE-2-DUMP. ST1174.2
052800 READ SQ-FS2 RECORD ST1174.2
052900 AT END GO TO FILE-2-DUMP-END. ST1174.2
053000 ADD 1 TO COUNT-OF-RECS. ST1174.2
053100 IF COUNT-OF-RECS GREATER THAN ST1174.2
053200 Card0101 ST1174.2
053300 MOVE " TOO MANY RECORDS" TO DUMMY-RECORD ST1174.2
053400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES ST1174.2
053500 GO TO FILE-2-DUMP-END. ST1174.2
053600 PERFORM FILE-2-DUMP-WRITE. ST1174.2
053700 GO TO FILE-2-DUMP. ST1174.2
053800 FILE-2-DUMP-WRITE. ST1174.2
053900 MOVE SQ-FS2R1-F-G-507 TO DUMMY-RECORD. ST1174.2
054000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2
054100 FILE-2-DUMP-END. ST1174.2
054200 MOVE " NUMBER OF SORTED RECORDS ON SQ-FS2 SHOWN BELOW" ST1174.2
054300 TO DUMMY-RECORD. ST1174.2
054400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2
054500 MOVE COUNT-OF-RECS TO DUMMY-RECORD. ST1174.2
054600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2
054700 CLOSE SQ-FS2. ST1174.2
054800 CCVS-EXIT SECTION. ST1174.2
054900 CCVS-999999. ST1174.2
055000 GO TO CLOSE-FILES. ST1174.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.
|
