000100 IDENTIFICATION DIVISION . IC1034.2
000200 PROGRAM-ID . IC1034.2
000300 IC103A. IC1034.2
000400**************************************************************** IC1034.2
000500* * IC1034.2
000600* VALIDATION FOR:- * IC1034.2
000700* * IC1034.2
000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1034.2
000900* * IC1034.2
001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1034.2
001100* * IC1034.2
001200**************************************************************** IC1034.2
001300* * IC1034.2
001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1034.2
001500* * IC1034.2
001600* X-55 - SYSTEM PRINTER NAME. * IC1034.2
001700* X-82 - SOURCE COMPUTER NAME. * IC1034.2
001800* X-83 - OBJECT COMPUTER NAME. * IC1034.2
001900* * IC1034.2
002000**************************************************************** IC1034.2
002100* THIS PROGRAM TESTS THE USE OF MULTIPLE DATA-NAMES IC1034.2
002200* IN THE USING PHRASE OF THE CALL STATEMENT. TWO 01 GROUP IC1034.2
002300* ITEMS AND AN ELEMENTARY 77 ITEM ARE THE PARAMETERS. THE IC1034.2
002400* DATA DEFINITIONS FOR THE GROUP ITEM PARAMETERS ARE NOT IC1034.2
002500* THE SAME AS IN THE SUBPROGRAM BUT THE NUMBER OF CHARACTERS IC1034.2
002600* ARE IDENTICAL. IC1034.2
002700* THIS PROGRAM ALSO CALLS A SUBPROGRAM WITH MORE IC1034.2
002800* THAN ONE EXIT PROGRAM STATEMENT. IC1034.2
002900 ENVIRONMENT DIVISION . IC1034.2
003000 CONFIGURATION SECTION . IC1034.2
003100 SOURCE-COMPUTER . IC1034.2
003200 Card0130. IC1034.2
003300 OBJECT-COMPUTER . IC1034.2
003400 Card0131. IC1034.2
003500 INPUT-OUTPUT SECTION . IC1034.2
003600 FILE-CONTROL . IC1034.2
003700 SELECT PRINT-FILE ASSIGN TO IC1034.2
003800 "C0085" . IC1034.2
003900 DATA DIVISION . IC1034.2
004000 FILE SECTION . IC1034.2
004100 FD PRINT-FILE. IC1034.2
004200 01 PRINT-REC PICTURE X(120). IC1034.2
004300 01 DUMMY-RECORD PICTURE X(120). IC1034.2
004400 WORKING-STORAGE SECTION . IC1034.2
004500 77 MAIN-DN1 PICTURE 999. IC1034.2
004600 77 MAIN-DN2 PICTURE S99 COMPUTATIONAL. IC1034.2
004700 77 ELEM-77 PICTURE V9(4) COMPUTATIONAL. IC1034.2
004800 01 GROUP-01. IC1034.2
004900 02 ALPHA-NUM-FIELD PIC X(5). IC1034.2
005000 02 GROUP-LEV2. IC1034.2
005100 03 NUMER-FIELD PIC 99. IC1034.2
005200 03 ALPHA-FIELD PIC A(3). IC1034.2
005300 01 GROUP-02. IC1034.2
005400 02 NUM-ITEM PIC S99. IC1034.2
005500 02 ALPHA-EDITED PICTURE X(6). IC1034.2
005600 01 TEST-RESULTS. IC1034.2
005700 02 FILLER PIC X VALUE SPACE . IC1034.2
005800 02 FEATURE PIC X(20) VALUE SPACE . IC1034.2
005900 02 FILLER PIC X VALUE SPACE . IC1034.2
006000 02 P-OR-F PIC X(5) VALUE SPACE . IC1034.2
006100 02 FILLER PIC X VALUE SPACE . IC1034.2
006200 02 PAR-NAME. IC1034.2
006300 03 FILLER PIC X(19) VALUE SPACE . IC1034.2
006400 03 PARDOT-X PIC X VALUE SPACE . IC1034.2
006500 03 DOTVALUE PIC 99 VALUE ZERO . IC1034.2
006600 02 FILLER PIC X(8) VALUE SPACE . IC1034.2
006700 02 RE-MARK PIC X(61). IC1034.2
006800 01 TEST-COMPUTED. IC1034.2
006900 02 FILLER PIC X(30) VALUE SPACE . IC1034.2
007000 02 FILLER PIC X(17) VALUE IC1034.2
007100 " COMPUTED=" . IC1034.2
007200 02 COMPUTED-X. IC1034.2
007300 03 COMPUTED-A PIC X(20) VALUE SPACE . IC1034.2
007400 03 COMPUTED-N REDEFINES COMPUTED-A IC1034.2
007500 PIC -9(9).9(9). IC1034.2
007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1034.2
007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1034.2
007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1034.2
007900 03 CM-18V0 REDEFINES COMPUTED-A. IC1034.2
008000 04 COMPUTED-18V0 PIC -9(18). IC1034.2
008100 04 FILLER PIC X. IC1034.2
008200 03 FILLER PIC X(50) VALUE SPACE . IC1034.2
008300 01 TEST-CORRECT. IC1034.2
008400 02 FILLER PIC X(30) VALUE SPACE . IC1034.2
008500 02 FILLER PIC X(17) VALUE " CORRECT =" . IC1034.2
008600 02 CORRECT-X. IC1034.2
008700 03 CORRECT-A PIC X(20) VALUE SPACE . IC1034.2
008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1034.2
008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1034.2
009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1034.2
009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1034.2
009200 03 CR-18V0 REDEFINES CORRECT-A. IC1034.2
009300 04 CORRECT-18V0 PIC -9(18). IC1034.2
009400 04 FILLER PIC X. IC1034.2
009500 03 FILLER PIC X(2) VALUE SPACE . IC1034.2
009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE . IC1034.2
009700 01 CCVS-C-1. IC1034.2
009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1034.2
009900- "SS PARAGRAPH-NAME IC1034.2
010000- " REMARKS" . IC1034.2
010100 02 FILLER PIC X(20) VALUE SPACE . IC1034.2
010200 01 CCVS-C-2. IC1034.2
010300 02 FILLER PIC X VALUE SPACE . IC1034.2
010400 02 FILLER PIC X(6) VALUE "TESTED" . IC1034.2
010500 02 FILLER PIC X(15) VALUE SPACE . IC1034.2
010600 02 FILLER PIC X(4) VALUE "FAIL" . IC1034.2
010700 02 FILLER PIC X(94) VALUE SPACE . IC1034.2
010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO . IC1034.2
010900 01 REC-CT PIC 99 VALUE ZERO . IC1034.2
011000 01 DELETE-COUNTER PIC 999 VALUE ZERO . IC1034.2
011100 01 ERROR-COUNTER PIC 999 VALUE ZERO . IC1034.2
011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO . IC1034.2
011300 01 PASS-COUNTER PIC 999 VALUE ZERO . IC1034.2
011400 01 TOTAL-ERROR PIC 999 VALUE ZERO . IC1034.2
011500 01 ERROR-HOLD PIC 999 VALUE ZERO . IC1034.2
011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE . IC1034.2
011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO . IC1034.2
011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES . IC1034.2
011900 01 CCVS-H-1. IC1034.2
012000 02 FILLER PIC X(39) VALUE SPACES . IC1034.2
012100 02 FILLER PIC X(42) VALUE IC1034.2
012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM" . IC1034.2
012300 02 FILLER PIC X(39) VALUE SPACES . IC1034.2
012400 01 CCVS-H-2A. IC1034.2
012500 02 FILLER PIC X(40) VALUE SPACE . IC1034.2
012600 02 FILLER PIC X(7) VALUE "CCVS85 " . IC1034.2
012700 02 FILLER PIC XXXX VALUE IC1034.2
012800 "4.2 " . IC1034.2
012900 02 FILLER PIC X(28) VALUE IC1034.2
013000 " COPY - NOT FOR DISTRIBUTION" . IC1034.2
013100 02 FILLER PIC X(41) VALUE SPACE . IC1034.2
013200 IC1034.2
013300 01 CCVS-H-2B. IC1034.2
013400 02 FILLER PIC X(15) VALUE IC1034.2
013500 "TEST RESULT OF " . IC1034.2
013600 02 TEST-ID PIC X(9). IC1034.2
013700 02 FILLER PIC X(4) VALUE IC1034.2
013800 " IN " . IC1034.2
013900 02 FILLER PIC X(12) VALUE IC1034.2
014000 " HIGH " . IC1034.2
014100 02 FILLER PIC X(22) VALUE IC1034.2
014200 " LEVEL VALIDATION FOR " . IC1034.2
014300 02 FILLER PIC X(58) VALUE IC1034.2
014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. " .IC1034.2
014500 01 CCVS-H-3. IC1034.2
014600 02 FILLER PIC X(34) VALUE IC1034.2
014700 " FOR OFFICIAL USE ONLY " . IC1034.2
014800 02 FILLER PIC X(58) VALUE IC1034.2
014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG " .IC1034.2
015000 02 FILLER PIC X(28) VALUE IC1034.2
015100 " COPYRIGHT 1985 " . IC1034.2
015200 01 CCVS-E-1. IC1034.2
015300 02 FILLER PIC X(52) VALUE SPACE . IC1034.2
015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- " . IC1034.2
015500 02 ID-AGAIN PIC X(9). IC1034.2
015600 02 FILLER PIC X(45) VALUE SPACES . IC1034.2
015700 01 CCVS-E-2. IC1034.2
015800 02 FILLER PIC X(31) VALUE SPACE . IC1034.2
015900 02 FILLER PIC X(21) VALUE SPACE . IC1034.2
016000 02 CCVS-E-2-2. IC1034.2
016100 03 ERROR-TOTAL PIC XXX VALUE SPACE . IC1034.2
016200 03 FILLER PIC X VALUE SPACE . IC1034.2
016300 03 ENDER-DESC PIC X(44) VALUE IC1034.2
016400 "ERRORS ENCOUNTERED" . IC1034.2
016500 01 CCVS-E-3. IC1034.2
016600 02 FILLER PIC X(22) VALUE IC1034.2
016700 " FOR OFFICIAL USE ONLY" . IC1034.2
016800 02 FILLER PIC X(12) VALUE SPACE . IC1034.2
016900 02 FILLER PIC X(58) VALUE IC1034.2
017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. " .IC1034.2
017100 02 FILLER PIC X(13) VALUE SPACE . IC1034.2
017200 02 FILLER PIC X(15) VALUE IC1034.2
017300 " COPYRIGHT 1985" . IC1034.2
017400 01 CCVS-E-4. IC1034.2
017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE . IC1034.2
017600 02 FILLER PIC X(4) VALUE " OF " . IC1034.2
017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE . IC1034.2
017800 02 FILLER PIC X(40) VALUE IC1034.2
017900 " TESTS WERE EXECUTED SUCCESSFULLY" . IC1034.2
018000 01 XXINFO. IC1034.2
018100 02 FILLER PIC X(19) VALUE IC1034.2
018200 "*** INFORMATION ***" . IC1034.2
018300 02 INFO-TEXT. IC1034.2
018400 04 FILLER PIC X(8) VALUE SPACE . IC1034.2
018500 04 XXCOMPUTED PIC X(20). IC1034.2
018600 04 FILLER PIC X(5) VALUE SPACE . IC1034.2
018700 04 XXCORRECT PIC X(20). IC1034.2
018800 02 INF-ANSI-REFERENCE PIC X(48). IC1034.2
018900 01 HYPHEN-LINE. IC1034.2
019000 02 FILLER PIC IS X VALUE IS SPACE . IC1034.2
019100 02 FILLER PIC IS X(65) VALUE IS "************************IC1034.2
019200- "*****************************************" . IC1034.2
019300 02 FILLER PIC IS X(54) VALUE IS "************************IC1034.2
019400- "******************************" . IC1034.2
019500 01 CCVS-PGM-ID PIC X(9) VALUE IC1034.2
019600 "IC103A" . IC1034.2
019700 PROCEDURE DIVISION . IC1034.2
019800 CCVS1 SECTION . IC1034.2
019900 OPEN-FILES. IC1034.2
020000 OPEN OUTPUT PRINT-FILE. IC1034.2
020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1034.2
020200 MOVE SPACE TO TEST-RESULTS. IC1034.2
020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1034.2
020400 GO TO CCVS1-EXIT. IC1034.2
020500 CLOSE-FILES. IC1034.2
020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1034.2
020700 TERMINATE-CCVS. IC1034.2
020800 EXIT PROGRAM . IC1034.2
020900 TERMINATE-CALL. IC1034.2
021000 STOP RUN . IC1034.2
021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1034.2
021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1034.2
021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1034.2
021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1034.2
021500 MOVE "****TEST DELETED****" TO RE-MARK. IC1034.2
021600 PRINT-DETAIL. IC1034.2
021700 IF REC-CT NOT EQUAL TO ZERO IC1034.2
021800 MOVE "." TO PARDOT-X IC1034.2
021900 MOVE REC-CT TO DOTVALUE. IC1034.2
022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1034.2
022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1034.2
022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1034.2
022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1034.2
022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1034.2
022500 MOVE SPACE TO CORRECT-X. IC1034.2
022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1034.2
022700 MOVE SPACE TO RE-MARK. IC1034.2
022800 HEAD-ROUTINE. IC1034.2
022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2
023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2
023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1034.2
023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1034.2
023300 COLUMN-NAMES-ROUTINE. IC1034.2
023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2
023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2
023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2
023700 END-ROUTINE. IC1034.2
023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1034.2
023900 END-RTN-EXIT. IC1034.2
024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2
024100 END-ROUTINE-1. IC1034.2
024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1034.2
024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1034.2
024400 ADD PASS-COUNTER TO ERROR-HOLD. IC1034.2
024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1034.2
024600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1034.2
024700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1034.2
024800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1034.2
024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1034.2
025000 END-ROUTINE-12. IC1034.2
025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1034.2
025200 IF ERROR-COUNTER IS EQUAL TO ZERO IC1034.2
025300 MOVE "NO " TO ERROR-TOTAL IC1034.2
025400 ELSE IC1034.2
025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1034.2
025600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1034.2
025700 PERFORM WRITE-LINE. IC1034.2
025800 END-ROUTINE-13. IC1034.2
025900 IF DELETE-COUNTER IS EQUAL TO ZERO IC1034.2
026000 MOVE "NO " TO ERROR-TOTAL ELSE IC1034.2
026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1034.2
026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1034.2
026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2
026400 IF INSPECT-COUNTER EQUAL TO ZERO IC1034.2
026500 MOVE "NO " TO ERROR-TOTAL IC1034.2
026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1034.2
026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1034.2
026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2
026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2
027000 WRITE-LINE. IC1034.2
027100 ADD 1 TO RECORD-COUNT. IC1034.2
027200 IF RECORD-COUNT GREATER 50 IC1034.2
027300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1034.2
027400 MOVE SPACE TO DUMMY-RECORD IC1034.2
027500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1034.2
027600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1034.2
027700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1034.2
027800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1034.2
027900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1034.2
028000 MOVE ZERO TO RECORD-COUNT. IC1034.2
028100 PERFORM WRT-LN. IC1034.2
028200 WRT-LN. IC1034.2
028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1034.2
028400 MOVE SPACE TO DUMMY-RECORD. IC1034.2
028500 BLANK-LINE-PRINT. IC1034.2
028600 PERFORM WRT-LN. IC1034.2
028700 FAIL-ROUTINE. IC1034.2
028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1034.2
028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1034.2
029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1034.2
029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1034.2
029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2
029300 MOVE SPACES TO INF-ANSI-REFERENCE. IC1034.2
029400 GO TO FAIL-ROUTINE-EX. IC1034.2
029500 FAIL-ROUTINE-WRITE. IC1034.2
029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1034.2
029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1034.2
029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1034.2
029900 MOVE SPACES TO COR-ANSI-REFERENCE. IC1034.2
030000 FAIL-ROUTINE-EX. EXIT . IC1034.2
030100 BAIL-OUT. IC1034.2
030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1034.2
030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1034.2
030400 BAIL-OUT-WRITE. IC1034.2
030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1034.2
030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1034.2
030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2
030800 MOVE SPACES TO INF-ANSI-REFERENCE. IC1034.2
030900 BAIL-OUT-EX. EXIT . IC1034.2
031000 CCVS1-EXIT. IC1034.2
031100 EXIT . IC1034.2
031200 SECT-IC103-0001 SECTION . IC1034.2
031300* THE TESTS IN THIS SECTION CALL A SUBPROGRAM WHICH IC1034.2
031400* HAS FOUR EXIT PROGRAM STATEMENTS. A DIFFERENT EXIT IS IC1034.2
031500* TAKEN FOR EACH CALL TO THE SUBPROGRAM. IC1034.2
031600 EXIT-INIT. IC1034.2
031700 MOVE "MULTIPLE EXIT PROGRM" TO FEATURE. IC1034.2
031800 EXIT-INIT-001. IC1034.2
031900 MOVE 0 TO MAIN-DN2. IC1034.2
032000 MOVE 1 TO MAIN-DN1. IC1034.2
032100 EXIT-TEST-001. IC1034.2
032200 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2
032300 IF MAIN-DN2 EQUAL TO 1 IC1034.2
032400 PERFORM PASS IC1034.2
032500 GO TO EXIT-WRITE-001. IC1034.2
032600 EXIT-FAIL-001. IC1034.2
032700 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2
032800 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2
032900 MOVE "FIRST EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2
033000 PERFORM FAIL. IC1034.2
033100 EXIT-WRITE-001. IC1034.2
033200 MOVE "EXIT-TEST-01" TO PAR-NAME. IC1034.2
033300 PERFORM PRINT-DETAIL. IC1034.2
033400 EXIT-INIT-002. IC1034.2
033500 MOVE 0 TO MAIN-DN2. IC1034.2
033600 MOVE 2 TO MAIN-DN1. IC1034.2
033700 EXIT-TEST-002. IC1034.2
033800 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2
033900 IF MAIN-DN2 EQUAL TO 2 IC1034.2
034000 PERFORM PASS IC1034.2
034100 GO TO EXIT-WRITE-002. IC1034.2
034200 EXIT-FAIL-002. IC1034.2
034300 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2
034400 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2
034500 MOVE "SECOND EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2
034600 PERFORM FAIL. IC1034.2
034700 EXIT-WRITE-002. IC1034.2
034800 MOVE "EXIT-TEST-02" TO PAR-NAME. IC1034.2
034900 PERFORM PRINT-DETAIL. IC1034.2
035000 EXIT-INIT-003. IC1034.2
035100 MOVE 0 TO MAIN-DN2. IC1034.2
035200 MOVE 3 TO MAIN-DN1. IC1034.2
035300 EXIT-TEST-003. IC1034.2
035400 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2
035500 IF MAIN-DN2 NOT EQUAL TO 3 IC1034.2
035600 GO TO EXIT-FAIL-003. IC1034.2
035700 PERFORM PASS. IC1034.2
035800 GO TO EXIT-WRITE-003. IC1034.2
035900 EXIT-FAIL-003. IC1034.2
036000 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2
036100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2
036200 MOVE "THIRD EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2
036300 PERFORM FAIL. IC1034.2
036400 EXIT-WRITE-003. IC1034.2
036500 MOVE "EXIT-TEST-03" TO PAR-NAME. IC1034.2
036600 PERFORM PRINT-DETAIL. IC1034.2
036700 EXIT-INIT-004. IC1034.2
036800 MOVE 0 TO MAIN-DN2. IC1034.2
036900 MOVE 4 TO MAIN-DN1. IC1034.2
037000 EXIT-TEST-004. IC1034.2
037100 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2
037200 IF MAIN-DN2 NOT EQUAL TO 4 IC1034.2
037300 GO TO EXIT-FAIL-004. IC1034.2
037400 PERFORM PASS. IC1034.2
037500 GO TO EXIT-WRITE-004. IC1034.2
037600 EXIT-FAIL-004. IC1034.2
037700 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2
037800 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2
037900 MOVE "FOURTH EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2
038000 PERFORM FAIL. IC1034.2
038100 EXIT-WRITE-004. IC1034.2
038200 MOVE "EXIT-TEST-04" TO PAR-NAME. IC1034.2
038300 PERFORM PRINT-DETAIL. IC1034.2
038400 GO TO SECT-IC103-0002. IC1034.2
038500 EXIT-DELETES. IC1034.2
038600* IF THE SUBPROGRAM WITH MULTIPLE EXIT PROGRAM IC1034.2
038700* STATEMENTS CANNOT BE INCLUDED IN THE RUN UNIT IC1034.2
038800* DELETE PARAGRAPH EXIT-INIT-001 THRU EXIT-WRITE-004. IC1034.2
038900 PERFORM DE-LETE. IC1034.2
039000 MOVE "EXIT-TEST-01" TO PAR-NAME. IC1034.2
039100 PERFORM PRINT-DETAIL. IC1034.2
039200 PERFORM DE-LETE. IC1034.2
039300 MOVE "EXIT-TEST-02" TO PAR-NAME. IC1034.2
039400 PERFORM PRINT-DETAIL. IC1034.2
039500 PERFORM DE-LETE. IC1034.2
039600 MOVE "EXIT-TEST-03" TO PAR-NAME. IC1034.2
039700 PERFORM PRINT-DETAIL. IC1034.2
039800 PERFORM DE-LETE. IC1034.2
039900 MOVE "EXIT-TEST-04" TO PAR-NAME. IC1034.2
040000 PERFORM PRINT-DETAIL. IC1034.2
040100 SECT-IC103-0002 SECTION . IC1034.2
040200* THIS SECTION CALLS A SUBPROGRAM WITH TWO GROUP ITEMS IC1034.2
040300* AND ONE ELEMENTARY ITEM IN THE USING PHRASE. THE ITEM IC1034.2
040400* DESCRIPTIONS ARE DIFFERENT IN THE SUBPROGRAM FROM THE MAIN IC1034.2
040500* PROGRAM, BUT THE NUMBER OF CHARACTERS IS IDENTICAL. IC1034.2
040600* REFERENCE X3.23-1974, SECTION XII, 3.1 AND 3.2. IC1034.2
040700 CALL-INIT-06. IC1034.2
040800 MOVE "CALL-TEST-06" TO PAR-NAME. IC1034.2
040900 MOVE 0 TO NUMER-FIELD ELEM-77 NUM-ITEM. IC1034.2
041000 MOVE SPACE TO ALPHA-NUM-FIELD ALPHA-FIELD ALPHA-EDITED. IC1034.2
041100 MOVE "CALL USING DN SERIES" TO FEATURE. IC1034.2
041200 CALL-TEST-06. IC1034.2
041300 CALL "IC104A" USING GROUP-01 ELEM-77 GROUP-02. IC1034.2
041400 GO TO CALL-TEST-06-01. IC1034.2
041500 CALL-DELETE-06. IC1034.2
041600 PERFORM DE-LETE. IC1034.2
041700 PERFORM PRINT-DETAIL. IC1034.2
041800 GO TO CCVS-EXIT. IC1034.2
041900* IF IC104 CANNOT BE INCLUDED IN THE RUN UNIT IC1034.2
042000* DELETE THE PARAGRAPH CALL-TEST-06. IC1034.2
042100 CALL-TEST-06-01. IC1034.2
042200 IF ALPHA-NUM-FIELD NOT EQUAL TO "IC104" IC1034.2
042300 GO TO CALL-FAIL-06-01. IC1034.2
042400 PERFORM PASS. IC1034.2
042500 GO TO CALL-WRITE-06-01. IC1034.2
042600 CALL-FAIL-06-01. IC1034.2
042700 MOVE ALPHA-NUM-FIELD TO COMPUTED-A. IC1034.2
042800 MOVE "IC104" TO CORRECT-A. IC1034.2
042900 PERFORM FAIL. IC1034.2
043000 MOVE "ALPHANUMERIC PARAMETER" TO RE-MARK. IC1034.2
043100 CALL-WRITE-06-01. IC1034.2
043200 ADD 1 TO REC-CT. IC1034.2
043300 PERFORM PRINT-DETAIL. IC1034.2
043400 CALL-TEST-06-02. IC1034.2
043500 IF NUMER-FIELD EQUAL TO 25 IC1034.2
043600 PERFORM PASS IC1034.2
043700 GO TO CALL-WRITE-06-02. IC1034.2
043800 CALL-FAIL-06-02. IC1034.2
043900 PERFORM FAIL. IC1034.2
044000 MOVE NUMER-FIELD TO COMPUTED-18V0. IC1034.2
044100 MOVE 25 TO CORRECT-18V0. IC1034.2
044200 MOVE "NUMERIC DISPLAY PARAMETER" TO RE-MARK. IC1034.2
044300 CALL-WRITE-06-02. IC1034.2
044400 ADD 1 TO REC-CT. IC1034.2
044500 PERFORM PRINT-DETAIL. IC1034.2
044600 CALL-TEST-06-03. IC1034.2
044700 IF ALPHA-FIELD EQUAL TO "YES" IC1034.2
044800 PERFORM PASS IC1034.2
044900 GO TO CALL-WRITE-06-03. IC1034.2
045000 CALL-FAIL-06-03. IC1034.2
045100 PERFORM FAIL. IC1034.2
045200 MOVE ALPHA-FIELD TO COMPUTED-A. IC1034.2
045300 MOVE "YES" TO CORRECT-A. IC1034.2
045400 MOVE "ALPHABETIC PARAMETER" TO RE-MARK. IC1034.2
045500 CALL-WRITE-06-03. IC1034.2
045600 ADD 1 TO REC-CT. IC1034.2
045700 PERFORM PRINT-DETAIL. IC1034.2
045800 CALL-TEST-06-04. IC1034.2
045900 IF ELEM-77 EQUAL TO 0.7654 IC1034.2
046000 PERFORM PASS IC1034.2
046100 GO TO CALL-WRITE-06-04. IC1034.2
046200 CALL-FAIL-06-04. IC1034.2
046300 PERFORM FAIL. IC1034.2
046400 MOVE ELEM-77 TO COMPUTED-4V14. IC1034.2
046500 MOVE 0.7654 TO CORRECT-4V14. IC1034.2
046600 MOVE "COMPUTATIONAL PARAMETER" TO RE-MARK. IC1034.2
046700 CALL-WRITE-06-04. IC1034.2
046800 ADD 1 TO REC-CT. IC1034.2
046900 PERFORM PRINT-DETAIL. IC1034.2
047000 CALL-TEST-06-05. IC1034.2
047100 IF NUM-ITEM EQUAL TO 25 IC1034.2
047200 PERFORM PASS IC1034.2
047300 GO TO CALL-WRITE-06-05. IC1034.2
047400 CALL-FAIL-06-05. IC1034.2
047500 PERFORM FAIL. IC1034.2
047600 MOVE NUM-ITEM TO COMPUTED-18V0. IC1034.2
047700 MOVE 25 TO CORRECT-18V0. IC1034.2
047800 MOVE "SIGNED NUMERIC PARAMETER" TO RE-MARK. IC1034.2
047900 CALL-WRITE-06-05. IC1034.2
048000 ADD 1 TO REC-CT. IC1034.2
048100 PERFORM PRINT-DETAIL. IC1034.2
048200 CALL-TEST-06-06. IC1034.2
048300 IF ALPHA-EDITED EQUAL TO "AB C0D" IC1034.2
048400 PERFORM PASS IC1034.2
048500 GO TO CALL-WRITE-06-06. IC1034.2
048600 CALL-FAIL-06-06. IC1034.2
048700 PERFORM FAIL. IC1034.2
048800 MOVE ALPHA-EDITED TO COMPUTED-A. IC1034.2
048900 MOVE "AB C0D" TO CORRECT-A. IC1034.2
049000 MOVE "ALPHANUMERIC EDITED" TO RE-MARK. IC1034.2
049100 CALL-WRITE-06-06. IC1034.2
049200 ADD 1 TO REC-CT. IC1034.2
049300 PERFORM PRINT-DETAIL. IC1034.2
049400 GO TO CCVS-EXIT. IC1034.2
049500 CCVS-EXIT SECTION . IC1034.2
049600 CCVS-999999. IC1034.2
049700 GO TO CLOSE-FILES. IC1034.2
quality 95%
¤ Dauer der Verarbeitung: 0.19 Sekunden
(vorverarbeitet)
¤
*© Formatika GbR, Deutschland