|
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.
000300 CM105M.
000400 AUTHOR.
000500 FEDERAL COMPILER TESTING CENTER.
000600 INSTALLATION.
000700 GENERAL SERVICES ADMINISTRATION
000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE.
000900 SOFTWARE DEVELOPMENT OFFICE.
001000 5203 LEESBURG PIKE SUITE 1100
001100 FALLS CHURCH VIRGINIA 22041.
001200
001300 PHONE (703) 756-6153
001400
001500 " HIGH ".
001600 DATE-WRITTEN.
001700 CCVS-74 VERSION 4.0 - 1980 JULY 1.
001800 CREATION DATE / VALIDATION DATE
001900 "4.2 ".
002000 SECURITY.
002100 NONE.
002200 ENVIRONMENT DIVISION.
002300 CONFIGURATION SECTION.
002400 SOURCE-COMPUTER.
002500 Card0130.
002600 OBJECT-COMPUTER.
002700 Card0131.
002800 INPUT-OUTPUT SECTION.
002900 FILE-CONTROL.
003000 SELECT PRINT-FILE ASSIGN TO
003100 "C0085" .
003200 DATA DIVISION.
003300 FILE SECTION.
003400 FD PRINT-FILE
003500 LABEL RECORDS
003600 Card0132
003700 DATA RECORD IS PRINT-REC DUMMY-RECORD.
003800 01 PRINT-REC PICTURE X(120).
003900 01 DUMMY-RECORD PICTURE X(120).
004000 WORKING-STORAGE SECTION.
004100 77 P PIC X(12).
004200 77 PP PIC X(24).
004300 77 PPP PIC X(36).
004400 77 PS PIC X(24).
004500 77 PSP PIC X(36).
004600 77 PPS PIC X(36).
004700 01 QUEUE-NAMES.
004800 02 PPPP PIC X(48) VALUE
004900 "C0056" .
005000 02 PPPS PIC X(48) VALUE
005100 "C0057" .
005200 02 PPSP PIC X(48) VALUE
005300 "C0064" .
005400 02 PSPP PIC X(48) VALUE
005500 "C0065" .
005600 01 QUEUE-NAMES-TABLE REDEFINES QUEUE-NAMES.
005700 02 NAME-SET PIC X(48) OCCURS 4 TIMES INDEXED BY I1.
005800 01 TEST-RESULTS.
005900 02 FILLER PICTURE X VALUE SPACE.
006000 02 FEATURE PICTURE X(18).
006100 02 FILLER PICTURE X VALUE SPACE.
006200 02 P-OR-F PICTURE X(5).
006300 02 FILLER PICTURE X VALUE SPACE.
006400 02 PAR-NAME PIC X(20).
006500 02 FILLER PICTURE X VALUE SPACE.
006600 02 COMPUTED-A.
006700 03 FILLER PIC X(9) VALUE SPACE.
006800 03 STAT PIC XX.
006900 03 FILLER PIC X(9) VALUE SPACE.
007000 02 FILLER PICTURE X VALUE SPACE.
007100 02 CORRECT-A.
007200 03 FILLER PIC X(8).
007300 03 CORRECT-QUEUE PIC X(4).
007400 03 FILLER PIC X(8).
007500 02 FILLER PICTURE X VALUE SPACE.
007600 02 RE-MARK.
007700 03 QUEUE-KEY PIC X(4).
007800 03 FILLER PIC X(26).
007900 01 COLUMNS-LINE-1.
008000 02 FILLER PIC X(3) VALUE SPACES.
008100 02 FILLER PIC X(17) VALUE "FEATURE TESTED".
008200 02 FILLER PIC X(9) VALUE "RESLT".
008300 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME".
008400 02 FILLER PIC X(22) VALUE "COMPUTED DATA".
008500 02 FILLER PIC X(29) VALUE "CORRECT DATA".
008600 02 FILLER PIC X(7) VALUE "REMARKS".
008700 01 COLUMNS-LINE-2.
008800 02 FILLER PIC X VALUE SPACE.
008900 02 FILLER PIC X(18) VALUE ALL "-".
009000 02 FILLER PIC X VALUE SPACE.
009100 02 FILLER PIC X(5) VALUE ALL "-".
009200 02 FILLER PIC X VALUE SPACE.
009300 02 FILLER PIC X(20) VALUE ALL "-".
009400 02 FILLER PIC X VALUE SPACE.
009500 02 FILLER PIC X(20) VALUE ALL "-".
009600 02 FILLER PIC X VALUE SPACE.
009700 02 FILLER PIC X(20) VALUE ALL "-".
009800 02 FILLER PIC X VALUE SPACE.
009900 02 FILLER PIC X(31) VALUE ALL "-".
010000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO.
010100 01 REC-CT PICTURE 99 VALUE ZERO.
010200 01 DELETE-CNT PICTURE 999 VALUE ZERO.
010300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO.
010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO.
010500 01 PASS-COUNTER PIC 999 VALUE ZERO.
010600 01 TOTAL-ERROR PIC 999 VALUE ZERO.
010700 01 ERROR-HOLD PIC 999 VALUE ZERO.
010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE.
010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO.
011000 01 CCVS-H-1.
011100 02 FILLER PICTURE X(27) VALUE SPACE.
011200 02 FILLER PICTURE X(67) VALUE
011300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION
011400- " SYSTEM".
011500 02 FILLER PICTURE X(26) VALUE SPACE.
011600 01 CCVS-H-2.
011700 02 FILLER PICTURE X(52) VALUE IS
011800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.".
011900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ".
012000 02 TEST-ID PICTURE IS X(9).
012100 02 FILLER PICTURE IS X(40) VALUE IS SPACE.
012200 01 CCVS-H-3.
012300 02 FILLER PICTURE X(34) VALUE
012400 " FOR OFFICIAL USE ONLY ".
012500 02 FILLER PICTURE X(58) VALUE
012600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".
012700 02 FILLER PICTURE X(28) VALUE
012800 " COPYRIGHT 1974 ".
012900 01 CCVS-E-1.
013000 02 FILLER PICTURE IS X(52) VALUE IS SPACE.
013100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ".
013200 02 ID-AGAIN PICTURE IS X(9).
013300 02 FILLER PICTURE X(45) VALUE IS
013400 " NTIS DISTRIBUTION COBOL 74".
013500 01 CCVS-E-2.
013600 02 FILLER PICTURE X(31) VALUE
013700 SPACE.
013800 02 FILLER PICTURE X(21) VALUE SPACE.
013900 02 CCVS-E-2-2.
014000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE.
014100 03 FILLER PICTURE IS X VALUE IS SPACE.
014200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED".
014300 01 CCVS-E-3.
014400 02 FILLER PICTURE X(22) VALUE
014500 " FOR OFFICIAL USE ONLY".
014600 02 FILLER PICTURE X(12) VALUE SPACE.
014700 02 FILLER PICTURE X(58) VALUE
014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".
014900 02 FILLER PICTURE X(13) VALUE SPACE.
015000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974".
015100 01 CCVS-E-4.
015200 02 CCVS-E-4-1 PIC XXX VALUE SPACE.
015300 02 FILLER PIC XXXX VALUE " OF ".
015400 02 CCVS-E-4-2 PIC XXX VALUE SPACE.
015500 02 FILLER PIC X(40) VALUE
015600 " TESTS WERE EXECUTED SUCCESSFULLY".
015700 01 XXINFO.
015800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***".
015900 02 INFO-TEXT.
016000 04 FILLER PIC X(20) VALUE SPACE.
016100 04 XXCOMPUTED PIC X(20).
016200 04 FILLER PIC X(5) VALUE SPACE.
016300 04 XXCORRECT PIC X(20).
016400 01 HYPHEN-LINE.
016500 02 FILLER PICTURE IS X VALUE IS SPACE.
016600 02 FILLER PICTURE IS X(65) VALUE IS "************************
016700- "*****************************************".
016800 02 FILLER PICTURE IS X(54) VALUE IS "************************
016900- "******************************".
017000 01 CCVS-PGM-ID PIC X(6) VALUE
017100 "CM105M".
017200 01 MAIN-QUEUE-NAME.
017300 02 MAIN-QUEUE PIC X(12).
017400 02 FILLER PIC X(36) VALUE SPACE.
017500*COMMUNICATION SECTION.
017600*CD CM-INQUE-1 INPUT STATUS KEY IS IN-STAT SUB-QUEUE-3
017700* IS-OF-NO-INTEREST COUNT NAMED-BELOW SOURCE NOT-USED.
017800 01 INQUE-RECORD.
017900 02 QUEUE-SET PIC X(48).
018000 02 FILLER PIC X(33).
018100 02 MSG-COUNT-N PIC 9(6).
018200 02 MSG-CNT REDEFINES MSG-COUNT-N.
018300 03 FILLER PIC X(4).
018400 03 MSG-COUNT PIC XX.
018500 PROCEDURE DIVISION.
018600 SECT-CM105M-0001 SECTION.
018700 CM105M-INIT.
018800 OPEN OUTPUT PRINT-FILE.
018900 MOVE "CM105M " TO TEST-ID.
019000 MOVE TEST-ID TO ID-AGAIN.
019100 MOVE SPACE TO TEST-RESULTS.
019200 PERFORM HEAD-ROUTINE.
019300 PERFORM COLUMN-NAMES-ROUTINE.
019400 MOVE
019500 "C0048"
019600 TO MAIN-QUEUE.
019700 MOVE MAIN-QUEUE-NAME TO QUEUE-SET.
019800* ENABLE INPUT CM-INQUE-1 KEY
019900* "C0049" .
020000 PERFORM BUILD-UP-QUEUES VARYING I1 FROM 1 BY 1
020100 UNTIL I1 IS GREATER THAN 4.
020200 GO TO BEGIN-TESTS.
020300 BUILD-UP-QUEUES.
020400 MOVE NAME-SET (I1) TO QUEUE-SET.
020500 ACCEPT CM-INQUE-1 COUNT.
020600 IF MSG-COUNT IS LESS THAN 10 GO TO BUILD-UP-QUEUES.
020700 BEGIN-TESTS.
020800* DISABLE INPUT CM-INQUE-1 KEY
020900* "C0049" .
021000 MOVE PPPP TO P PP PPP.
021100 MOVE PPSP TO PPS.
021200 MOVE PSPP TO PS PSP.
021300 QUEUE-TEST-01.
021400 MOVE "QUEUE SERIES PPPP" TO FEATURE.
021500 MOVE PPPP TO QUEUE-SET.
021600 PERFORM RECEIVE-A-MSG.
021700 IF QUEUE-KEY IS EQUAL TO "PPPP"
021800 PERFORM PASS GO TO QUEUE-TEST-WRITE-01.
021900 MOVE "PPPP" TO CORRECT-QUEUE.
022000 PERFORM FAIL.
022100 QUEUE-TEST-WRITE-01.
022200 MOVE "QUEUE-TEST-01" TO PAR-NAME.
022300 PERFORM PRINT-DETAIL.
022400 QUEUE-TEST-02.
022500 MOVE "QUEUE SERIES PPPS" TO FEATURE.
022600 MOVE PPPS TO QUEUE-SET.
022700 PERFORM RECEIVE-A-MSG.
022800 IF QUEUE-KEY IS EQUAL TO "PPPS"
022900 PERFORM PASS GO TO QUEUE-TEST-WRITE-02.
023000 MOVE "PPPS" TO CORRECT-QUEUE.
023100 PERFORM FAIL.
023200 QUEUE-TEST-WRITE-02.
023300 MOVE "QUEUE-TEST-02" TO PAR-NAME.
023400 PERFORM PRINT-DETAIL.
023500 QUEUE-TEST-03.
023600 MOVE "QUEUE SERIES PPSP" TO FEATURE.
023700 MOVE PPSP TO QUEUE-SET.
023800 PERFORM RECEIVE-A-MSG.
023900 IF QUEUE-KEY IS EQUAL TO "PPSP"
024000 PERFORM PASS GO TO QUEUE-TEST-WRITE-03.
024100 MOVE "PPSP" TO CORRECT-QUEUE.
024200 PERFORM FAIL.
024300 QUEUE-TEST-WRITE-03.
024400 MOVE "QUEUE-TEST-03" TO PAR-NAME.
024500 PERFORM PRINT-DETAIL.
024600 QUEUE-TEST-04.
024700 MOVE "QUEUE SERIES PSPP" TO FEATURE.
024800 MOVE PSPP TO QUEUE-SET.
024900 PERFORM RECEIVE-A-MSG.
025000 IF QUEUE-KEY IS EQUAL TO "PSPP"
025100 PERFORM PASS GO TO QUEUE-TEST-WRITE-04.
025200 MOVE "PSPP" TO CORRECT-QUEUE.
025300 PERFORM FAIL.
025400 QUEUE-TEST-WRITE-04.
025500 MOVE "QUEUE-TEST-04" TO PAR-NAME.
025600 PERFORM PRINT-DETAIL.
025700 QUEUE-TEST-05.
025800 MOVE "QUEUE SERIES P" TO FEATURE.
025900 MOVE P TO QUEUE-SET.
026000 PERFORM RECEIVE-A-MSG.
026100 IF QUEUE-KEY IS EQUAL TO "PPPP"
026200 PERFORM PASS GO TO QUEUE-TEST-WRITE-05.
026300 MOVE "PPPP" TO CORRECT-QUEUE.
026400 PERFORM FAIL.
026500 QUEUE-TEST-WRITE-05.
026600 MOVE "QUEUE-TEST-05" TO PAR-NAME.
026700 PERFORM PRINT-DETAIL.
026800 QUEUE-TEST-06.
026900 MOVE "QUEUE SERIES PP" TO FEATURE.
027000 MOVE PP TO QUEUE-SET.
027100 PERFORM RECEIVE-A-MSG.
027200 IF QUEUE-KEY IS EQUAL TO "PPPP"
027300 PERFORM PASS GO TO QUEUE-TEST-WRITE-06.
027400 MOVE "PPPP" TO CORRECT-QUEUE.
027500 PERFORM FAIL.
027600 QUEUE-TEST-WRITE-06.
027700 MOVE "QUEUE-TEST-06" TO PAR-NAME.
027800 PERFORM PRINT-DETAIL.
027900 QUEUE-TEST-07.
028000 MOVE "QUEUE SERIES PPP" TO FEATURE.
028100 MOVE PPP TO QUEUE-SET.
028200 PERFORM RECEIVE-A-MSG.
028300 IF QUEUE-KEY IS EQUAL TO "PPPP"
028400 PERFORM PASS GO TO QUEUE-TEST-WRITE-07.
028500 MOVE "PPPP" TO CORRECT-QUEUE.
028600 PERFORM FAIL.
028700 QUEUE-TEST-WRITE-07.
028800 MOVE "QUEUE-TEST-07" TO PAR-NAME.
028900 PERFORM PRINT-DETAIL.
029000 QUEUE-TEST-08.
029100 MOVE "QUEUE SERIES PS" TO FEATURE.
029200 MOVE PS TO QUEUE-SET.
029300 PERFORM RECEIVE-A-MSG.
029400 IF QUEUE-KEY IS EQUAL TO "PSPP"
029500 PERFORM PASS GO TO QUEUE-TEST-WRITE-08.
029600 MOVE "PSPP" TO CORRECT-QUEUE.
029700 PERFORM FAIL.
029800 QUEUE-TEST-WRITE-08.
029900 MOVE "QUEUE-TEST-08" TO PAR-NAME.
030000 PERFORM PRINT-DETAIL.
030100 QUEUE-TEST-09.
030200 MOVE "QUEUE SERIES PSP" TO FEATURE.
030300 MOVE PSP TO QUEUE-SET.
030400 PERFORM RECEIVE-A-MSG.
030500 IF QUEUE-KEY IS EQUAL TO "PSPP"
030600 PERFORM PASS GO TO QUEUE-TEST-WRITE-09.
030700 MOVE "PSPP" TO CORRECT-QUEUE.
030800 PERFORM FAIL.
030900 QUEUE-TEST-WRITE-09.
031000 MOVE "QUEUE-TEST-09" TO PAR-NAME.
031100 PERFORM PRINT-DETAIL.
031200 QUEUE-TEST-10.
031300 MOVE "QUEUE SERIES PPS" TO FEATURE.
031400 MOVE PPS TO QUEUE-SET.
031500 PERFORM RECEIVE-A-MSG.
031600 IF QUEUE-KEY IS EQUAL TO "PPSP"
031700 PERFORM PASS GO TO QUEUE-TEST-WRITE-10.
031800 MOVE "PPSP" TO CORRECT-QUEUE.
031900 PERFORM FAIL.
032000 QUEUE-TEST-WRITE-10.
032100 MOVE "QUEUE-TEST-10" TO PAR-NAME.
032200 PERFORM PRINT-DETAIL.
032300 ACCEPT-TEST-01.
032400 MOVE "ACCEPT GROUP QUEUE" TO FEATURE.
032500 MOVE PPPP TO QUEUE-SET.
032600 ACCEPT CM-INQUE-1 COUNT.
032700 IF IN-STAT IS NOT EQUAL TO "00"
032800 MOVE IN-STAT TO STAT
032900 MOVE "BAD STATUS FOR PPPP" TO RE-MARK
033000 ELSE
033100 MOVE MSG-COUNT TO STAT
033200 MOVE "COUNT FOR PPPP" TO RE-MARK.
033300 PERFORM ACCEPT-WRITE-01.
033400 MOVE PPPS TO QUEUE-SET.
033500 ACCEPT CM-INQUE-1 COUNT.
033600 IF IN-STAT IS NOT EQUAL TO "00"
033700 MOVE IN-STAT TO STAT
033800 MOVE "BAD STATUS FOR PPPS" TO RE-MARK
033900 ELSE
034000 MOVE MSG-COUNT TO STAT
034100 MOVE "COUNT FOR PPPS" TO RE-MARK.
034200 PERFORM ACCEPT-WRITE-01.
034300 MOVE PPSP TO QUEUE-SET.
034400 ACCEPT CM-INQUE-1 COUNT.
034500 IF IN-STAT IS NOT EQUAL TO "00"
034600 MOVE IN-STAT TO STAT
034700 MOVE "BAD STATUS FOR PPSP" TO RE-MARK
034800 ELSE
034900 MOVE MSG-COUNT TO STAT
035000 MOVE "COUNT FOR PPSP" TO RE-MARK.
035100 PERFORM ACCEPT-WRITE-01.
035200 MOVE PSPP TO QUEUE-SET.
035300 ACCEPT CM-INQUE-1 COUNT.
035400 IF IN-STAT IS NOT EQUAL TO "00"
035500 MOVE IN-STAT TO STAT
035600 MOVE "BAD STATUS FOR PSPP" TO RE-MARK
035700 ELSE
035800 MOVE MSG-COUNT TO STAT
035900 MOVE "COUNT FOR PSPP" TO RE-MARK.
036000 PERFORM ACCEPT-WRITE-01.
036100 MOVE P TO QUEUE-SET.
036200 ACCEPT CM-INQUE-1 COUNT.
036300 IF IN-STAT IS NOT EQUAL TO "00"
036400 MOVE IN-STAT TO STAT
036500 MOVE "BAD STATUS FOR P" TO RE-MARK
036600 ELSE
036700 MOVE MSG-COUNT TO STAT
036800 MOVE "COUNT FOR P" TO RE-MARK.
036900 PERFORM ACCEPT-WRITE-01.
037000 MOVE PP TO QUEUE-SET.
037100 ACCEPT CM-INQUE-1 COUNT.
037200 IF IN-STAT IS NOT EQUAL TO "00"
037300 MOVE IN-STAT TO STAT
037400 MOVE "BAD STATUS FOR PP" TO STAT
037500 ELSE
037600 MOVE MSG-COUNT TO STAT
037700 MOVE "COUNT FOR PP" TO RE-MARK.
037800 PERFORM ACCEPT-WRITE-01.
037900 MOVE PPP TO QUEUE-SET.
038000 ACCEPT CM-INQUE-1 COUNT.
038100 IF IN-STAT IS NOT EQUAL TO "00"
038200 MOVE IN-STAT TO STAT
038300 MOVE "BAD STATUS FOR PPP" TO STAT
038400 ELSE
038500 MOVE MSG-COUNT TO STAT
038600 MOVE "COUNT FOR PPP" TO RE-MARK.
038700 PERFORM ACCEPT-WRITE-01.
038800 MOVE PS TO QUEUE-SET.
038900 ACCEPT CM-INQUE-1 COUNT.
039000 IF IN-STAT IS NOT EQUAL TO "00"
039100 MOVE IN-STAT TO STAT
039200 MOVE "BAD STATUS FOR PS" TO STAT
039300 ELSE
039400 MOVE MSG-COUNT TO STAT
039500 MOVE "COUNT FOR PS" TO RE-MARK.
039600 PERFORM ACCEPT-WRITE-01.
039700 MOVE PSP TO QUEUE-SET.
039800 ACCEPT CM-INQUE-1 COUNT.
039900 IF IN-STAT IS NOT EQUAL TO "00"
040000 MOVE IN-STAT TO STAT
040100 MOVE "BAD STATUS FOR PSP" TO STAT
040200 ELSE
040300 MOVE MSG-COUNT TO STAT
040400 MOVE "COUNT FOR PSP" TO RE-MARK.
040500 PERFORM ACCEPT-WRITE-01.
040600 MOVE PPS TO QUEUE-SET.
040700 ACCEPT CM-INQUE-1 COUNT.
040800 IF IN-STAT IS NOT EQUAL TO "00"
040900 MOVE IN-STAT TO STAT
041000 MOVE "BAD STATUS FOR PPS" TO STAT
041100 ELSE
041200 MOVE MSG-COUNT TO STAT
041300 MOVE "COUNT FOR PPS" TO RE-MARK.
041400 PERFORM ACCEPT-WRITE-01.
041500 GO TO CM105-FINI.
041600 ACCEPT-WRITE-01.
041700 MOVE "ACCEPT-TEST-01" TO PAR-NAME.
041800 MOVE "INFO" TO P-OR-F.
041900 PERFORM PRINT-DETAIL.
042000 CM105-FINI.
042100 PERFORM END-ROUTINE THRU END-ROUTINE-4.
042200 CLOSE PRINT-FILE.
042300 STOP RUN.
042400 RECEIVE-A-MSG.
042500 MOVE SPACE TO RE-MARK.
042600* RECEIVE CM-INQUE-1 MESSAGE INTO RE-MARK
042700* NO DATA MOVE "NOTHING RECEIVED FROM MCS" TO RE-MARK.
042800 COMMON-SUBROUTINES SECTION.
042900 PASS.
043000 MOVE "PASS" TO P-OR-F.
043100 FAIL.
043200 MOVE " SEE REMARKS COLUMN " TO COMPUTED-A.
043300 ADD 1 TO ERROR-COUNTER.
043400 MOVE "FAIL*" TO P-OR-F.
043500 PRINT-DETAIL.
043600 MOVE TEST-RESULTS TO PRINT-REC.
043700 PERFORM WRITE-LINE.
043800 MOVE SPACE TO P-OR-F.
043900 MOVE SPACE TO COMPUTED-A.
044000 MOVE SPACE TO CORRECT-A.
044100 MOVE SPACE TO RE-MARK.
044200 COLUMN-NAMES-ROUTINE.
044300 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD.
044400 PERFORM WRITE-LINE.
044500 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD.
044600 PERFORM WRITE-LINE.
044700 PERFORM BLANK-LINE-PRINT.
044800 END-ROUTINE.
044900 MOVE HYPHEN-LINE TO DUMMY-RECORD.
045000 PERFORM WRITE-LINE.
045100 PARA-Z.
045200 PERFORM BLANK-LINE-PRINT 4 TIMES.
045300 MOVE CCVS-E-1 TO DUMMY-RECORD.
045400 PERFORM WRITE-LINE.
045500 END-ROUTINE-1.
045600 PERFORM BLANK-LINE-PRINT.
045700 IF ERROR-COUNTER IS EQUAL TO ZERO
045800 GO TO END-ROUTINE-2.
045900 MOVE ERROR-COUNTER TO ERROR-TOTAL.
046000 GO TO END-ROUTINE-3.
046100 END-ROUTINE-2.
046200 MOVE " NO" TO ERROR-TOTAL.
046300 END-ROUTINE-3.
046400 MOVE CCVS-E-2 TO DUMMY-RECORD.
046500 PERFORM WRITE-LINE.
046600 IF DELETE-CNT IS EQUAL TO ZERO
046700 MOVE " NO" TO ERROR-TOTAL ELSE
046800 MOVE DELETE-CNT TO ERROR-TOTAL.
046900 MOVE "TESTS DELETED " TO ENDER-DESC.
047000 MOVE CCVS-E-2 TO DUMMY-RECORD.
047100 PERFORM WRITE-LINE.
047200 END-ROUTINE-4.
047300 MOVE CCVS-E-3 TO DUMMY-RECORD.
047400 PERFORM WRITE-LINE.
047500 BLANK-LINE-PRINT.
047600 MOVE SPACE TO DUMMY-RECORD.
047700 PERFORM WRITE-LINE.
047800 WRITE-LINE.
047900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE.
048000 HEAD-ROUTINE.
048100 MOVE CCVS-H-1 TO PRINT-REC
048200 WRITE PRINT-REC
048300 AFTER ADVANCING PAGE.
048400 MOVE CCVS-H-2 TO PRINT-REC.
048500 WRITE PRINT-REC
048600 AFTER 2 LINES.
048700 MOVE CCVS-H-3 TO PRINT-REC.
048800 WRITE PRINT-REC
048900 AFTER 5 LINES.
049000 MOVE HYPHEN-LINE TO PRINT-REC.
049100 PERFORM WRITE-LINE.
¤ Dauer der Verarbeitung: 0.95 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.
|
