|
000100 IDENTIFICATION DIVISION. DB1044.2
000200 PROGRAM-ID. DB1044.2
000300 DB104A. DB1044.2
000400 AUTHOR. DB1044.2
000500 FEDERAL COMPILER TESTING CENTER. DB1044.2
000600 INSTALLATION. DB1044.2
000700 GENERAL SERVICES ADMINISTRATION DB1044.2
000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB1044.2
000900 SOFTWARE DEVELOPMENT OFFICE. DB1044.2
001000 5203 LEESBURG PIKE SUITE 1100 DB1044.2
001100 FALLS CHURCH VIRGINIA 22041. DB1044.2
001200 DB1044.2
001300 PHONE (703) 756-6153 DB1044.2
001400 DB1044.2
001500 " HIGH ". DB1044.2
001600 DATE-WRITTEN. DB1044.2
001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB1044.2
001800 CREATION DATE / VALIDATION DATE DB1044.2
001900 "4.2 ". DB1044.2
002000 SECURITY. DB1044.2
002100 NONE. DB1044.2
002200* DB1044.2
002300* * * * * * * * * * * * * * * * * * * * * *DB1044.2
002400* DB1044.2
002500* PROGRAM ABSTRACT DB1044.2
002600* DB1044.2
002700* DB104A TESTS THE CAPABILITY OF THE DEBUG MODULE TO HANDLE DB1044.2
002800* PROCEDURES TIED TO SORT INPUT, SORT OUTPUT, AND FILE DB1044.2
002900* DECLARATIVE PROCEDURES. THIS PROGRAM IS TO BE COMPILED AND DB1044.2
003000* EXECUTED WITH BOTH COMPILE AND OBJECT TIME DEBUGGING DB1044.2
003100* SWITCHES ENABLED. THE PROGRAM FIRST BUILDS A SEQUENTIAL DB1044.2
003200* FILE CONTAINING 99 EIGHTY CHARACTER RECORDS. THIS FILE DB1044.2
003300* IS THEN SORTED. DB1044.2
003400* DB1044.2
003500* ALL DEBUGGING PROCEDURES SHOULD BE INCLUDED IN COMPILATION DB1044.2
003600* AND GENERATE CODE. BEFORE BEGINNING EXECUTION OF THE OBJECT DB1044.2
003700* PROGRAM, THE JOB CONTROL LANGUAGE NECESSARY TO ACTIVATE DB1044.2
003800* THE OBJECT TIME DEBUGGING SWITCH MUST BE SUBMITTED. DB1044.2
003900* DB1044.2
004000* EXECUTION OF THE PROGRAM"S SORT SHOULD TRIGGER DEBUGGING DB1044.2
004100* PROCEDURES AT THE BEGINNING OF THE SORT INPUT AND SORT DB1044.2
004200* OUTPUT PROCEDURES. DURING EXECUTION OF THE SORT INPUT DB1044.2
004300* PROCEDURE, END-OF-FILE CONDITION ON THE INPUT FILE SHOULD DB1044.2
004400* TRIGGER A DECLARATIVE PROCEDURE ASSOCIATED WITH THE FILE, DB1044.2
004500* AND THIS IN TURN SHOULD CAUSE EXECUTION OF A DEBUGGING DB1044.2
004600* PROCEDURE MONITORING THE FILE DECLARATIVE PROCEDURE. DB1044.2
004700* DB1044.2
004800* THE PERFORMANCE OF THE SORT VERB IS NOT CHECKED IN DB104. DB1044.2
004900* DB1044.2
005000* DB1044.2
005100* DB1044.2
005200 ENVIRONMENT DIVISION. DB1044.2
005300 CONFIGURATION SECTION. DB1044.2
005400 SOURCE-COMPUTER. DB1044.2
005500 Card0130 DB1044.2
005600 WITH DEBUGGING MODE. DB1044.2
005700 OBJECT-COMPUTER. DB1044.2
005800 Card0131. DB1044.2
005900 INPUT-OUTPUT SECTION. DB1044.2
006000 FILE-CONTROL. DB1044.2
006100 SELECT PRINT-FILE ASSIGN TO DB1044.2
006200 "C0085" . DB1044.2
006300 SELECT GEN-FILE ASSIGN TO DB1044.2
006400 "C0020" DB1044.2
006500 FILE STATUS IS GEN-STATUS. DB1044.2
006600* XXXXX014 REPLACE WITH SEQUENTIAL ACCESS SCRATCH FILE NAME DB1044.2
006700 SELECT SORT-FILE ASSIGN TO DB1044.2
006800 "C0039" . DB1044.2
006900* XXXXX27 REPLACE WITH SORT FILE NAME DB1044.2
007000 DATA DIVISION. DB1044.2
007100 FILE SECTION. DB1044.2
007200 FD PRINT-FILE DB1044.2
007300 LABEL RECORDS DB1044.2
007400 Card0132 DB1044.2
007500 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB1044.2
007600 01 PRINT-REC PICTURE X(120). DB1044.2
007700 01 DUMMY-RECORD PICTURE X(120). DB1044.2
007800 FD GEN-FILE DB1044.2
007900 VALUE OF DB1044.2
008000 Impl1 DB1044.2
008100* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB1044.2
008200 IS DB1044.2
008300 4711 DB1044.2
008400* XXXXX075 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB1044.2
008500 DB1044.2
008600* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB1044.2
008700 LABEL RECORD IS STANDARD. DB1044.2
008800 01 GEN-REC PIC X(80). DB1044.2
008900 SD SORT-FILE. DB1044.2
009000 01 SORT-REC. DB1044.2
009100 02 FILLER PIC X(34). DB1044.2
009200 02 SORT-REC-NO PIC 9(6). DB1044.2
009300 02 FILLER PIC X(40). DB1044.2
009400 WORKING-STORAGE SECTION. DB1044.2
009500 77 RESULT-FLAG PIC 99 COMP VALUE 0. DB1044.2
009600 77 DBLINE-HOLD PIC X(6). DB1044.2
009700 77 DBNAME-HOLD PIC X(30). DB1044.2
009800 77 DBCONT-HOLD PIC X(30). DB1044.2
009900 01 FILE-RECORD-INFORMATION-REC. DB1044.2
010000 03 FILE-RECORD-INFO-SKELETON. DB1044.2
010100 05 FILLER PICTURE X(48) VALUE DB1044.2
010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". DB1044.2
010300 05 FILLER PICTURE X(46) VALUE DB1044.2
010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". DB1044.2
010500 05 FILLER PICTURE X(26) VALUE DB1044.2
010600 ",LFIL=000000,ORG= ,LBLR= ". DB1044.2
010700 05 FILLER PICTURE X(37) VALUE DB1044.2
010800 ",RECKEY= ". DB1044.2
010900 05 FILLER PICTURE X(38) VALUE DB1044.2
011000 ",ALTKEY1= ". DB1044.2
011100 05 FILLER PICTURE X(38) VALUE DB1044.2
011200 ",ALTKEY2= ". DB1044.2
011300 05 FILLER PICTURE X(7) VALUE SPACE.DB1044.2
011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. DB1044.2
011500 05 FILE-RECORD-INFO-P1-120. DB1044.2
011600 07 FILLER PIC X(5). DB1044.2
011700 07 XFILE-NAME PIC X(6). DB1044.2
011800 07 FILLER PIC X(8). DB1044.2
011900 07 XRECORD-NAME PIC X(6). DB1044.2
012000 07 FILLER PIC X(1). DB1044.2
012100 07 REELUNIT-NUMBER PIC 9(1). DB1044.2
012200 07 FILLER PIC X(7). DB1044.2
012300 07 XRECORD-NUMBER PIC 9(6). DB1044.2
012400 07 FILLER PIC X(6). DB1044.2
012500 07 UPDATE-NUMBER PIC 9(2). DB1044.2
012600 07 FILLER PIC X(5). DB1044.2
012700 07 ODO-NUMBER PIC 9(4). DB1044.2
012800 07 FILLER PIC X(5). DB1044.2
012900 07 XPROGRAM-NAME PIC X(5). DB1044.2
013000 07 FILLER PIC X(7). DB1044.2
013100 07 XRECORD-LENGTH PIC 9(6). DB1044.2
013200 07 FILLER PIC X(7). DB1044.2
013300 07 CHARS-OR-RECORDS PIC X(2). DB1044.2
013400 07 FILLER PIC X(1). DB1044.2
013500 07 XBLOCK-SIZE PIC 9(4). DB1044.2
013600 07 FILLER PIC X(6). DB1044.2
013700 07 RECORDS-IN-FILE PIC 9(6). DB1044.2
013800 07 FILLER PIC X(5). DB1044.2
013900 07 XFILE-ORGANIZATION PIC X(2). DB1044.2
014000 07 FILLER PIC X(6). DB1044.2
014100 07 XLABEL-TYPE PIC X(1). DB1044.2
014200 05 FILE-RECORD-INFO-P121-240. DB1044.2
014300 07 FILLER PIC X(8). DB1044.2
014400 07 XRECORD-KEY PIC X(29). DB1044.2
014500 07 FILLER PIC X(9). DB1044.2
014600 07 ALTERNATE-KEY1 PIC X(29). DB1044.2
014700 07 FILLER PIC X(9). DB1044.2
014800 07 ALTERNATE-KEY2 PIC X(29). DB1044.2
014900 07 FILLER PIC X(7). DB1044.2
015000 01 GEN-STATUS. DB1044.2
015100 02 END-FLAG PIC X. DB1044.2
015200 02 FILLER PIC X. DB1044.2
015300 01 SIZE-13. DB1044.2
015400 02 FILLER PIC XX. DB1044.2
015500 02 SIZE-11. DB1044.2
015600 03 FILLER PIC X. DB1044.2
015700 03 SIZE-10. DB1044.2
015800 04 FILLER PIC XX. DB1044.2
015900 04 SIZE-8. DB1044.2
016000 05 FILLER PIC X. DB1044.2
016100 05 SIZE-7 PIC X(7). DB1044.2
016200 01 TEST-RESULTS. DB1044.2
016300 02 FILLER PICTURE X VALUE SPACE. DB1044.2
016400 02 FEATURE PICTURE X(20) VALUE SPACE. DB1044.2
016500 02 FILLER PICTURE X VALUE SPACE. DB1044.2
016600 02 P-OR-F PICTURE X(5) VALUE SPACE. DB1044.2
016700 02 FILLER PICTURE X VALUE SPACE. DB1044.2
016800 02 PAR-NAME. DB1044.2
016900 03 FILLER PICTURE X(12) VALUE SPACE. DB1044.2
017000 03 PARDOT-X PICTURE X VALUE SPACE. DB1044.2
017100 03 DOTVALUE PICTURE 99 VALUE ZERO. DB1044.2
017200 03 FILLER PIC X(5) VALUE SPACE. DB1044.2
017300 02 FILLER PIC X(10) VALUE SPACE. DB1044.2
017400 02 RE-MARK PIC X(61). DB1044.2
017500 01 TEST-COMPUTED. DB1044.2
017600 02 FILLER PIC X(30) VALUE SPACE. DB1044.2
017700 02 FILLER PIC X(17) VALUE " COMPUTED=". DB1044.2
017800 02 COMPUTED-X. DB1044.2
017900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB1044.2
018000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB1044.2
018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB1044.2
018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB1044.2
018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB1044.2
018400 03 CM-18V0 REDEFINES COMPUTED-A. DB1044.2
018500 04 COMPUTED-18V0 PICTURE -9(18). DB1044.2
018600 04 FILLER PICTURE X. DB1044.2
018700 03 FILLER PIC X(50) VALUE SPACE. DB1044.2
018800 01 TEST-CORRECT. DB1044.2
018900 02 FILLER PIC X(30) VALUE SPACE. DB1044.2
019000 02 FILLER PIC X(17) VALUE " CORRECT =". DB1044.2
019100 02 CORRECT-X. DB1044.2
019200 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB1044.2
019300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB1044.2
019400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB1044.2
019500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB1044.2
019600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB1044.2
019700 03 CR-18V0 REDEFINES CORRECT-A. DB1044.2
019800 04 CORRECT-18V0 PICTURE -9(18). DB1044.2
019900 04 FILLER PICTURE X. DB1044.2
020000 03 FILLER PIC X(50) VALUE SPACE. DB1044.2
020100 01 CCVS-C-1. DB1044.2
020200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB1044.2
020300- "SS PARAGRAPH-NAME DB1044.2
020400- " REMARKS". DB1044.2
020500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB1044.2
020600 01 CCVS-C-2. DB1044.2
020700 02 FILLER PICTURE IS X VALUE IS SPACE. DB1044.2
020800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB1044.2
020900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB1044.2
021000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB1044.2
021100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB1044.2
021200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB1044.2
021300 01 REC-CT PICTURE 99 VALUE ZERO. DB1044.2
021400 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB1044.2
021500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB1044.2
021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB1044.2
021700 01 PASS-COUNTER PIC 999 VALUE ZERO. DB1044.2
021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB1044.2
021900 01 ERROR-HOLD PIC 999 VALUE ZERO. DB1044.2
022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB1044.2
022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB1044.2
022200 01 CCVS-H-1. DB1044.2
022300 02 FILLER PICTURE X(27) VALUE SPACE. DB1044.2
022400 02 FILLER PICTURE X(67) VALUE DB1044.2
022500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB1044.2
022600- " SYSTEM". DB1044.2
022700 02 FILLER PICTURE X(26) VALUE SPACE. DB1044.2
022800 01 CCVS-H-2. DB1044.2
022900 02 FILLER PICTURE X(52) VALUE IS DB1044.2
023000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB1044.2
023100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB1044.2
023200 02 TEST-ID PICTURE IS X(9). DB1044.2
023300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB1044.2
023400 01 CCVS-H-3. DB1044.2
023500 02 FILLER PICTURE X(34) VALUE DB1044.2
023600 " FOR OFFICIAL USE ONLY ". DB1044.2
023700 02 FILLER PICTURE X(58) VALUE DB1044.2
023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB1044.2
023900 02 FILLER PICTURE X(28) VALUE DB1044.2
024000 " COPYRIGHT 1974 ". DB1044.2
024100 01 CCVS-E-1. DB1044.2
024200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB1044.2
024300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB1044.2
024400 02 ID-AGAIN PICTURE IS X(9). DB1044.2
024500 02 FILLER PICTURE X(45) VALUE IS DB1044.2
024600 " NTIS DISTRIBUTION COBOL 74". DB1044.2
024700 01 CCVS-E-2. DB1044.2
024800 02 FILLER PICTURE X(31) VALUE DB1044.2
024900 SPACE. DB1044.2
025000 02 FILLER PICTURE X(21) VALUE SPACE. DB1044.2
025100 02 CCVS-E-2-2. DB1044.2
025200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB1044.2
025300 03 FILLER PICTURE IS X VALUE IS SPACE. DB1044.2
025400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB1044.2
025500 01 CCVS-E-3. DB1044.2
025600 02 FILLER PICTURE X(22) VALUE DB1044.2
025700 " FOR OFFICIAL USE ONLY". DB1044.2
025800 02 FILLER PICTURE X(12) VALUE SPACE. DB1044.2
025900 02 FILLER PICTURE X(58) VALUE DB1044.2
026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB1044.2
026100 02 FILLER PICTURE X(13) VALUE SPACE. DB1044.2
026200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB1044.2
026300 01 CCVS-E-4. DB1044.2
026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB1044.2
026500 02 FILLER PIC XXXX VALUE " OF ". DB1044.2
026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB1044.2
026700 02 FILLER PIC X(40) VALUE DB1044.2
026800 " TESTS WERE EXECUTED SUCCESSFULLY". DB1044.2
026900 01 XXINFO. DB1044.2
027000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB1044.2
027100 02 INFO-TEXT. DB1044.2
027200 04 FILLER PIC X(20) VALUE SPACE. DB1044.2
027300 04 XXCOMPUTED PIC X(20). DB1044.2
027400 04 FILLER PIC X(5) VALUE SPACE. DB1044.2
027500 04 XXCORRECT PIC X(20). DB1044.2
027600 01 HYPHEN-LINE. DB1044.2
027700 02 FILLER PICTURE IS X VALUE IS SPACE. DB1044.2
027800 02 FILLER PICTURE IS X(65) VALUE IS "************************DB1044.2
027900- "*****************************************". DB1044.2
028000 02 FILLER PICTURE IS X(54) VALUE IS "************************DB1044.2
028100- "******************************". DB1044.2
028200 01 CCVS-PGM-ID PIC X(6) VALUE DB1044.2
028300 "DB104A". DB1044.2
028400 PROCEDURE DIVISION. DB1044.2
028500 DECLARATIVES. DB1044.2
028600 SORT-IN-PROC SECTION. DB1044.2
028700 USE FOR DEBUGGING ON SORT-IN. DB1044.2
028800 BEGIN-SORT-IN-PROC. DB1044.2
028900 MOVE 1 TO RESULT-FLAG. DB1044.2
029000 DB-COMMON. DB1044.2
029100 MOVE DEBUG-LINE TO DBLINE-HOLD. DB1044.2
029200 MOVE DEBUG-NAME TO DBNAME-HOLD. DB1044.2
029300 MOVE DEBUG-CONTENTS TO DBCONT-HOLD. DB1044.2
029400 SORT-OUT-PROC SECTION. DB1044.2
029500 USE FOR DEBUGGING ON SORT-OUT. DB1044.2
029600 BEGIN-SORT-OUT-PROC. DB1044.2
029700 MOVE 2 TO RESULT-FLAG. DB1044.2
029800 PERFORM DB-COMMON. DB1044.2
029900 USE-PROC SECTION. DB1044.2
030000 USE FOR DEBUGGING ON AT-END-PROC. DB1044.2
030100 BEGIN-USE-PROC. DB1044.2
030200 ADD 3 TO RESULT-FLAG. DB1044.2
030300 PERFORM DB-COMMON. DB1044.2
030400 AT-END-PROC SECTION. DB1044.2
030500 USE AFTER ERROR PROCEDURE ON GEN-FILE. DB1044.2
030600 BEGIN-AT-END-PROC. DB1044.2
030700 ADD 4 TO RESULT-FLAG. DB1044.2
030800 END DECLARATIVES. DB1044.2
030900 CCVS1 SECTION. DB1044.2
031000 OPEN-FILES. DB1044.2
031100 OPEN OUTPUT PRINT-FILE. DB1044.2
031200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB1044.2
031300 MOVE SPACE TO TEST-RESULTS. DB1044.2
031400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB1044.2
031500 GO TO CCVS1-EXIT. DB1044.2
031600 CLOSE-FILES. DB1044.2
031700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB1044.2
031800 TERMINATE-CCVS. DB1044.2
031900 EXIT PROGRAM. DB1044.2
032000 TERMINATE-CALL. DB1044.2
032100 STOP RUN. DB1044.2
032200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1044.2
032300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1044.2
032400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1044.2
032500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1044.2
032600 MOVE "****TEST DELETED****" TO RE-MARK. DB1044.2
032700 PRINT-DETAIL. DB1044.2
032800 IF REC-CT NOT EQUAL TO ZERO DB1044.2
032900 MOVE "." TO PARDOT-X DB1044.2
033000 MOVE REC-CT TO DOTVALUE. DB1044.2
033100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB1044.2
033200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB1044.2
033300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB1044.2
033400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB1044.2
033500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1044.2
033600 MOVE SPACE TO CORRECT-X. DB1044.2
033700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1044.2
033800 MOVE SPACE TO RE-MARK. DB1044.2
033900 HEAD-ROUTINE. DB1044.2
034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2
034100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB1044.2
034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB1044.2
034300 COLUMN-NAMES-ROUTINE. DB1044.2
034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2
034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2
034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2
034700 END-ROUTINE. DB1044.2
034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB1044.2
034900 END-RTN-EXIT. DB1044.2
035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2
035100 END-ROUTINE-1. DB1044.2
035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB1044.2
035300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB1044.2
035400 ADD PASS-COUNTER TO ERROR-HOLD. DB1044.2
035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB1044.2
035600 MOVE PASS-COUNTER TO CCVS-E-4-1. DB1044.2
035700 MOVE ERROR-HOLD TO CCVS-E-4-2. DB1044.2
035800 MOVE CCVS-E-4 TO CCVS-E-2-2. DB1044.2
035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB1044.2
036000 END-ROUTINE-12. DB1044.2
036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB1044.2
036200 IF ERROR-COUNTER IS EQUAL TO ZERO DB1044.2
036300 MOVE "NO " TO ERROR-TOTAL DB1044.2
036400 ELSE DB1044.2
036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB1044.2
036600 MOVE CCVS-E-2 TO DUMMY-RECORD. DB1044.2
036700 PERFORM WRITE-LINE. DB1044.2
036800 END-ROUTINE-13. DB1044.2
036900 IF DELETE-CNT IS EQUAL TO ZERO DB1044.2
037000 MOVE "NO " TO ERROR-TOTAL ELSE DB1044.2
037100 MOVE DELETE-CNT TO ERROR-TOTAL. DB1044.2
037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB1044.2
037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2
037400 IF INSPECT-COUNTER EQUAL TO ZERO DB1044.2
037500 MOVE "NO " TO ERROR-TOTAL DB1044.2
037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB1044.2
037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB1044.2
037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2
037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2
038000 WRITE-LINE. DB1044.2
038100 ADD 1 TO RECORD-COUNT. DB1044.2
038200 IF RECORD-COUNT GREATER 50 DB1044.2
038300 MOVE DUMMY-RECORD TO DUMMY-HOLD DB1044.2
038400 MOVE SPACE TO DUMMY-RECORD DB1044.2
038500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1044.2
038600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB1044.2
038700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB1044.2
038800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB1044.2
038900 MOVE DUMMY-HOLD TO DUMMY-RECORD DB1044.2
039000 MOVE ZERO TO RECORD-COUNT. DB1044.2
039100 PERFORM WRT-LN. DB1044.2
039200 WRT-LN. DB1044.2
039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1044.2
039400 MOVE SPACE TO DUMMY-RECORD. DB1044.2
039500 BLANK-LINE-PRINT. DB1044.2
039600 PERFORM WRT-LN. DB1044.2
039700 FAIL-ROUTINE. DB1044.2
039800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1044.2
039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1044.2
040000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1044.2
040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2
040200 GO TO FAIL-ROUTINE-EX. DB1044.2
040300 FAIL-ROUTINE-WRITE. DB1044.2
040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB1044.2
040500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB1044.2
040600 FAIL-ROUTINE-EX. EXIT. DB1044.2
040700 BAIL-OUT. DB1044.2
040800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB1044.2
040900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB1044.2
041000 BAIL-OUT-WRITE. DB1044.2
041100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1044.2
041200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2
041300 BAIL-OUT-EX. EXIT. DB1044.2
041400 CCVS1-EXIT. DB1044.2
041500 EXIT. DB1044.2
041600 BEGIN-FILE-GENERATION. DB1044.2
041700 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1). DB1044.2
041800 MOVE "GEN-FI" TO XFILE-NAME (1). DB1044.2
041900 MOVE "GEN-RE" TO XRECORD-NAME (1). DB1044.2
042000 MOVE "DB104A" TO XPROGRAM-NAME (1). DB1044.2
042100 MOVE 80 TO XRECORD-LENGTH (1). DB1044.2
042200 OPEN OUTPUT GEN-FILE. DB1044.2
042300 MOVE 99 TO XRECORD-NUMBER (1). DB1044.2
042400 GEN-LOOP. DB1044.2
042500 MOVE FILE-RECORD-INFO (1) TO GEN-REC. DB1044.2
042600 WRITE GEN-REC. DB1044.2
042700 IF XRECORD-NUMBER (1) IS GREATER THAN 5 DB1044.2
042800 SUBTRACT 5 FROM XRECORD-NUMBER (1) DB1044.2
042900 GO TO GEN-LOOP. DB1044.2
043000 END-OF-GEN-LOOP. DB1044.2
043100 MOVE 98 TO XRECORD-NUMBER (1). DB1044.2
043200 PERFORM GEN-LOOP. DB1044.2
043300 MOVE 97 TO XRECORD-NUMBER (1). DB1044.2
043400 PERFORM GEN-LOOP. DB1044.2
043500 MOVE 96 TO XRECORD-NUMBER (1). DB1044.2
043600 PERFORM GEN-LOOP. DB1044.2
043700 MOVE 95 TO XRECORD-NUMBER (1). DB1044.2
043800 PERFORM GEN-LOOP. DB1044.2
043900 CLOSE GEN-FILE. DB1044.2
044000******************************************************************DB1044.2
044100* THE DEBUG-LINE (INSPT) SUBTESTS FOR THE TESTS NAMED IN THE *DB1044.2
044200* OUTPUT REPORT AS "SORT-IN-2" AND "SORT-OUT-2" SHOULD POINT *DB1044.2
044300* TO THE "SORT" STATEMENT WHICH APPEARS IN THE PARAGRAPH *DB1044.2
044400* BELOW NAMED "BEGIN-TESTS". *DB1044.2
044500******************************************************************DB1044.2
044600 BEGIN-TESTS. DB1044.2
044700 MOVE 0 TO RESULT-FLAG. DB1044.2
044800 SORT SORT-FILE ON ASCENDING KEY SORT-REC-NO DB1044.2
044900 INPUT PROCEDURE IS SORT-IN DB1044.2
045000 OUTPUT PROCEDURE IS SORT-OUT. DB1044.2
045100 GO TO AFTER-SORT. DB1044.2
045200 SORT-IN SECTION. DB1044.2
045300 SORT-IN-1. DB1044.2
045400 MOVE "SORT-IN-1" TO PAR-NAME. DB1044.2
045500 IF RESULT-FLAG IS NOT EQUAL TO 1 DB1044.2
045600 MOVE "DEBUG PROCEDURE NOT EXECUTED" TO RE-MARK DB1044.2
045700 PERFORM FAIL-1 DB1044.2
045800 PERFORM SORT-IN-WRITE DB1044.2
045900 GO TO SORT-IN-5 DB1044.2
046000 ELSE PERFORM PASS-1 DB1044.2
046100 MOVE "DEBUG PROCEDURE EXECUTED" TO RE-MARK. DB1044.2
046200 PERFORM SORT-IN-WRITE. DB1044.2
046300 GO TO SORT-IN-2. DB1044.2
046400 SORT-IN-DELETE. DB1044.2
046500 MOVE "SORT-IN" TO PAR-NAME. DB1044.2
046600 PERFORM DE-LETE-1. DB1044.2
046700 PERFORM SORT-IN-WRITE. DB1044.2
046800 GO TO SORT-IN-5. DB1044.2
046900 SORT-IN-WRITE. DB1044.2
047000 MOVE "DEBUG SORT INPUT" TO FEATURE. DB1044.2
047100 PERFORM PRINT-DETAIL-1. DB1044.2
047200 SORT-IN-2. DB1044.2
047300 MOVE "SORT-IN-2" TO PAR-NAME. DB1044.2
047400 MOVE DBLINE-HOLD TO COMPUTED-A. DB1044.2
047500 MOVE "DEBUG-LINE, SEE NEXT LINE" TO RE-MARK. DB1044.2
047600 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1044.2
047700 PERFORM INSPT-1. DB1044.2
047800 PERFORM SORT-IN-WRITE. DB1044.2
047900 SORT-IN-3. DB1044.2
048000 MOVE DBNAME-HOLD TO SIZE-7. DB1044.2
048100 IF SIZE-7 IS EQUAL TO "SORT-IN" DB1044.2
048200 PERFORM PASS-1 ELSE DB1044.2
048300 MOVE "SORT-IN" TO CORRECT-A DB1044.2
048400 MOVE DBNAME-HOLD TO COMPUTED-A DB1044.2
048500 PERFORM FAIL-1. DB1044.2
048600 MOVE "DEBUG-NAME" TO RE-MARK. DB1044.2
048700 MOVE "SORT-IN-3" TO PAR-NAME. DB1044.2
048800 PERFORM SORT-IN-WRITE. DB1044.2
048900 SORT-IN-4. DB1044.2
049000 MOVE DBCONT-HOLD TO SIZE-10. DB1044.2
049100 IF SIZE-10 IS EQUAL TO "SORT INPUT" DB1044.2
049200 PERFORM PASS-1 ELSE DB1044.2
049300 MOVE "SORT INPUT" TO CORRECT-A DB1044.2
049400 MOVE DBCONT-HOLD TO COMPUTED-A DB1044.2
049500 PERFORM FAIL-1. DB1044.2
049600 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1044.2
049700 MOVE "SORT-IN-4" TO PAR-NAME. DB1044.2
049800 PERFORM SORT-IN-WRITE. DB1044.2
049900 SORT-IN-5. DB1044.2
050000 OPEN INPUT GEN-FILE. DB1044.2
050100 MOVE 0 TO RESULT-FLAG. DB1044.2
050200******************************************************************DB1044.2
050300* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1044.2
050400* OUTPUT REPORT AS "SORT-USE-TEST" SHOULD POINT TO THE *DB1044.2
050500* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1044.2
050600* WHICH READS, "READ GEN-FILE". *DB1044.2
050700******************************************************************DB1044.2
050800 SORT-USE-TEST. DB1044.2
050900 READ GEN-FILE DB1044.2
051000* AT END GO TO SORT-USE-DELETE. DB1044.2
051100* DB1044.2
051200* IN CASE IMPLEMENTATION FAILS TO NOTIFY PROGRAM OF DB1044.2
051300* END-OF-FILE VIA STATUS OR DECLARATIVE PROC, REMOVE ASTERISK DB1044.2
051400* FROM THE FIRST OF THESE COMMENT LINES AND PERMIT THE AT END DB1044.2
051500* CLAUSE TO BE COMPILED; THIS WILL RESULT IN TEST DELETION. DB1044.2
051600* DB1044.2
051700 IF RESULT-FLAG IS EQUAL TO 3 DB1044.2
051800 CLOSE GEN-FILE GO TO SORT-USE-1. DB1044.2
051900 IF RESULT-FLAG IS EQUAL TO 4 DB1044.2
052000 CLOSE GEN-FILE GO TO SORT-USE-3. DB1044.2
052100 IF RESULT-FLAG IS EQUAL TO 7 DB1044.2
052200 CLOSE GEN-FILE DB1044.2
052300 PERFORM PASS-1 DB1044.2
052400 MOVE "BOTH PROCEDURES EXECUTED" TO RE-MARK DB1044.2
052500 PERFORM SORT-USE-WRITE DB1044.2
052600 GO TO SORT-USE-2. DB1044.2
052700 IF END-FLAG IS EQUAL TO "1" DB1044.2
052800 CLOSE GEN-FILE GO TO SORT-USE-4. DB1044.2
052900 RELEASE SORT-REC FROM GEN-REC. DB1044.2
053000 GO TO SORT-USE-TEST. DB1044.2
053100 SORT-USE-DELETE. DB1044.2
053200 CLOSE GEN-FILE. DB1044.2
053300 PERFORM DE-LETE-1. DB1044.2
053400 GO TO SORT-USE-WRITE. DB1044.2
053500 SORT-USE-1. DB1044.2
053600 MOVE "ERROR PROCEDURE NOT COMPLETED" TO RE-MARK. DB1044.2
053700 PERFORM SORT-USE-WRITE. DB1044.2
053800 SORT-USE-2. DB1044.2
053900 MOVE "DEBUG-LINE, SEE NEXT LINE" TO RE-MARK. DB1044.2
054000 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1044.2
054100 MOVE DBLINE-HOLD TO COMPUTED-A. DB1044.2
054200 PERFORM INSPT-1. DB1044.2
054300 PERFORM SORT-USE-WRITE. DB1044.2
054400 MOVE DBNAME-HOLD TO SIZE-11. DB1044.2
054500 IF SIZE-11 IS EQUAL TO "AT-END-PROC" DB1044.2
054600 PERFORM PASS-1 ELSE DB1044.2
054700 MOVE DBNAME-HOLD TO COMPUTED-A DB1044.2
054800 MOVE "AT-END-PROC" TO CORRECT-A DB1044.2
054900 PERFORM FAIL-1. DB1044.2
055000 MOVE "DEBUG-NAME" TO RE-MARK. DB1044.2
055100 PERFORM SORT-USE-WRITE. DB1044.2
055200 MOVE DBCONT-HOLD TO SIZE-13. DB1044.2
055300 IF SIZE-13 IS EQUAL TO "USE PROCEDURE" DB1044.2
055400 PERFORM PASS-1 ELSE DB1044.2
055500 MOVE DBCONT-HOLD TO COMPUTED-A DB1044.2
055600 MOVE "USE PROCEDURE" TO CORRECT-A DB1044.2
055700 PERFORM FAIL-1. DB1044.2
055800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1044.2
055900 GO TO SORT-USE-WRITE. DB1044.2
056000 SORT-USE-3. DB1044.2
056100 MOVE "DEBUG ON USE PROC NOT EXECUTED" TO RE-MARK. DB1044.2
056200 PERFORM FAIL-1. DB1044.2
056300 GO TO SORT-USE-WRITE. DB1044.2
056400 SORT-USE-4. DB1044.2
056500 MOVE "DEBUG AND USE PROCS BOTH FAIL" TO RE-MARK. DB1044.2
056600 PERFORM FAIL-1. DB1044.2
056700 SORT-USE-WRITE. DB1044.2
056800 MOVE "SORT-USE-TEST" TO PAR-NAME. DB1044.2
056900 MOVE "DEBUG USE PROC" TO FEATURE. DB1044.2
057000 PERFORM PRINT-DETAIL-1. DB1044.2
057100 SORT-USE-DONE. DB1044.2
057200 GO TO SORT-IN-EXIT. DB1044.2
057300 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1044.2
057400 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1044.2
057500 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1044.2
057600 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1044.2
057700 MOVE "****TEST DELETED****" TO RE-MARK. DB1044.2
057800 PRINT-DETAIL-1. DB1044.2
057900 IF REC-CT NOT EQUAL TO ZERO DB1044.2
058000 MOVE "." TO PARDOT-X DB1044.2
058100 MOVE REC-CT TO DOTVALUE. DB1044.2
058200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. DB1044.2
058300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 DB1044.2
058400 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 DB1044.2
058500 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. DB1044.2
058600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1044.2
058700 MOVE SPACE TO CORRECT-X. DB1044.2
058800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1044.2
058900 MOVE SPACE TO RE-MARK. DB1044.2
059000 WRITE-LINE-1. DB1044.2
059100 ADD 1 TO RECORD-COUNT. DB1044.2
059200 IF RECORD-COUNT GREATER 50 DB1044.2
059300 MOVE DUMMY-RECORD TO DUMMY-HOLD DB1044.2
059400 MOVE SPACE TO DUMMY-RECORD DB1044.2
059500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1044.2
059600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 DB1044.2
059700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES DB1044.2
059800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 DB1044.2
059900 MOVE DUMMY-HOLD TO DUMMY-RECORD DB1044.2
060000 MOVE ZERO TO RECORD-COUNT. DB1044.2
060100 PERFORM WRT-LN-1. DB1044.2
060200 WRT-LN-1. DB1044.2
060300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1044.2
060400 MOVE SPACE TO DUMMY-RECORD. DB1044.2
060500 BLANK-LINE-PRINT-1. DB1044.2
060600 PERFORM WRT-LN-1. DB1044.2
060700 FAIL-ROUTINE-1. DB1044.2
060800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. DB1044.2
060900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. DB1044.2
061000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1044.2
061100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. DB1044.2
061200 GO TO FAIL-ROUTINE-EX-1. DB1044.2
061300 FAIL-RTN-WRITE-1. DB1044.2
061400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 DB1044.2
061500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. DB1044.2
061600 FAIL-ROUTINE-EX-1. EXIT. DB1044.2
061700 BAIL-OUT-1. DB1044.2
061800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. DB1044.2
061900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. DB1044.2
062000 BAIL-OUT-WRITE-1. DB1044.2
062100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1044.2
062200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. DB1044.2
062300 BAIL-OUT-EX-1. EXIT. DB1044.2
062400 SORT-IN-EXIT. DB1044.2
062500 MOVE 0 TO RESULT-FLAG. DB1044.2
062600 SORT-OUT SECTION. DB1044.2
062700 SORT-OUT-1. DB1044.2
062800 MOVE "SORT-OUT-1" TO PAR-NAME. DB1044.2
062900 IF RESULT-FLAG IS NOT EQUAL TO 2 DB1044.2
063000 PERFORM FAIL-2 DB1044.2
063100 MOVE "DEBUG PROCEDURE NOT EXECUTED" TO RE-MARK DB1044.2
063200 GO TO SORT-OUT-WRITE. DB1044.2
063300 PERFORM PASS-2. DB1044.2
063400 MOVE "DEBUG PROCEDURE EXECUTED" TO RE-MARK. DB1044.2
063500 PERFORM SORT-OUT-WRITE. DB1044.2
063600 SORT-OUT-2. DB1044.2
063700 MOVE "SORT-OUT-2" TO PAR-NAME. DB1044.2
063800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1044.2
063900 MOVE "DEBUG-LINE, SEE NEXT LINE" TO RE-MARK. DB1044.2
064000 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1044.2
064100 PERFORM INSPT-2. DB1044.2
064200 PERFORM SORT-OUT-WRITE. DB1044.2
064300 SORT-OUT-3. DB1044.2
064400 MOVE "SORT-OUT-3" TO PAR-NAME. DB1044.2
064500 MOVE DBNAME-HOLD TO SIZE-8. DB1044.2
064600 IF SIZE-8 IS EQUAL TO "SORT-OUT" DB1044.2
064700 PERFORM PASS-2 ELSE DB1044.2
064800 MOVE "SORT-OUT" TO CORRECT-A DB1044.2
064900 MOVE DBNAME-HOLD TO COMPUTED-A DB1044.2
065000 PERFORM FAIL-2. DB1044.2
065100 MOVE "DEBUG-NAME" TO RE-MARK. DB1044.2
065200 PERFORM SORT-OUT-WRITE. DB1044.2
065300 SORT-OUT-4. DB1044.2
065400 MOVE "SORT-OUT-4" TO PAR-NAME. DB1044.2
065500 MOVE DBCONT-HOLD TO SIZE-11. DB1044.2
065600 IF SIZE-11 IS EQUAL TO "SORT OUTPUT" DB1044.2
065700 PERFORM PASS-2 ELSE DB1044.2
065800 MOVE "SORT OUTPUT" TO CORRECT-A DB1044.2
065900 MOVE DBCONT-HOLD TO COMPUTED-A DB1044.2
066000 PERFORM FAIL-2. DB1044.2
066100 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1044.2
066200 GO TO SORT-OUT-WRITE. DB1044.2
066300 SORT-OUT-DELETE. DB1044.2
066400 MOVE "SORT-OUT" TO PAR-NAME. DB1044.2
066500 PERFORM DE-LETE-2. DB1044.2
066600 SORT-OUT-WRITE. DB1044.2
066700 MOVE "DEBUG SORT OUTPUT" TO FEATURE. DB1044.2
066800 PERFORM PRINT-DETAIL-2. DB1044.2
066900 SORT-OUT-5. DB1044.2
067000 OPEN OUTPUT GEN-FILE. DB1044.2
067100 SORT-OUT-6. DB1044.2
067200 RETURN SORT-FILE INTO GEN-REC DB1044.2
067300 AT END GO TO SORT-OUT-EXIT. DB1044.2
067400 WRITE GEN-REC. DB1044.2
067500 GO TO SORT-OUT-6. DB1044.2
067600 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1044.2
067700 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1044.2
067800 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1044.2
067900 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1044.2
068000 MOVE "****TEST DELETED****" TO RE-MARK. DB1044.2
068100 PRINT-DETAIL-2. DB1044.2
068200 IF REC-CT NOT EQUAL TO ZERO DB1044.2
068300 MOVE "." TO PARDOT-X DB1044.2
068400 MOVE REC-CT TO DOTVALUE. DB1044.2
068500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. DB1044.2
068600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 DB1044.2
068700 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 DB1044.2
068800 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. DB1044.2
068900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1044.2
069000 MOVE SPACE TO CORRECT-X. DB1044.2
069100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1044.2
069200 MOVE SPACE TO RE-MARK. DB1044.2
069300 WRITE-LINE-2. DB1044.2
069400 ADD 1 TO RECORD-COUNT. DB1044.2
069500 IF RECORD-COUNT GREATER 50 DB1044.2
069600 MOVE DUMMY-RECORD TO DUMMY-HOLD DB1044.2
069700 MOVE SPACE TO DUMMY-RECORD DB1044.2
069800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1044.2
069900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 DB1044.2
070000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES DB1044.2
070100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 DB1044.2
070200 MOVE DUMMY-HOLD TO DUMMY-RECORD DB1044.2
070300 MOVE ZERO TO RECORD-COUNT. DB1044.2
070400 PERFORM WRT-LN-2. DB1044.2
070500 WRT-LN-2. DB1044.2
070600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1044.2
070700 MOVE SPACE TO DUMMY-RECORD. DB1044.2
070800 BLANK-LINE-PRINT-2. DB1044.2
070900 PERFORM WRT-LN-2. DB1044.2
071000 FAIL-ROUTINE-2. DB1044.2
071100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. DB1044.2
071200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. DB1044.2
071300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1044.2
071400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. DB1044.2
071500 GO TO FAIL-ROUTINE-EX-2. DB1044.2
071600 FAIL-RTN-WRITE-2. DB1044.2
071700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 DB1044.2
071800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. DB1044.2
071900 FAIL-ROUTINE-EX-2. EXIT. DB1044.2
072000 BAIL-OUT-2. DB1044.2
072100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. DB1044.2
072200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. DB1044.2
072300 BAIL-OUT-WRITE-2. DB1044.2
072400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1044.2
072500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. DB1044.2
072600 BAIL-OUT-EX-2. EXIT. DB1044.2
072700 SORT-OUT-EXIT. DB1044.2
072800 CLOSE GEN-FILE. DB1044.2
072900 MOVE 0 TO RESULT-FLAG. DB1044.2
073000 END-OF-SORT SECTION. DB1044.2
073100 AFTER-SORT. DB1044.2
073200 EXIT. DB1044.2
073300 DUMP-CODING SECTION. DB1044.2
073400 BEGIN-DUMP. DB1044.2
073500 OPEN INPUT GEN-FILE. DB1044.2
073600 PERFORM BLANK-LINE-PRINT. DB1044.2
073700 MOVE " DUMP OF GEN-FILE FOLLOWS:" TO PRINT-REC. DB1044.2
073800 PERFORM WRITE-LINE. DB1044.2
073900 DUMP-FILE-1. DB1044.2
074000 READ GEN-FILE AT END GO TO DUMP-FILE-2. DB1044.2
074100 MOVE GEN-REC TO PRINT-REC. DB1044.2
074200 PERFORM WRITE-LINE. DB1044.2
074300 GO TO DUMP-FILE-1. DB1044.2
074400 DUMP-FILE-2. DB1044.2
074500 CLOSE GEN-FILE. DB1044.2
074600 CCVS-EXIT SECTION. DB1044.2
074700 CCVS-999999. DB1044.2
074800 GO TO CLOSE-FILES. DB1044.2
¤ Dauer der Verarbeitung: 0.61 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.
|
