| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/Cobol/Test-Suite/ Datei vom 4.1.2008 mit Größe 26 MB |
|
Impressum newcob.val Sprache: unbekannt |
|
|
Spracherkennung für: .val vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen] CCVS85 VERSION 4.0 01 OCT 1992 0032
*HEADER,COBOL,EXEC85 000100 IDENTIFICATION DIVISION. EXEC84.2 000200 EXEC84.2 000400 PROGRAM-ID. EXEC84.2 000500 EXEC85. EXEC84.2 000600 INSTALLATION. EXEC84.2 000700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".EXEC84.2 000800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".EXEC84.2 000900 ENVIRONMENT DIVISION. EXEC84.2 001000 EXEC84.2 001100**************************************************************** EXEC84.2 001200* * EXEC84.2 001300* VALIDATION FOR:- * EXEC84.2 001400* * EXEC84.2 001500* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".EXEC84.2 001600* * EXEC84.2 001700* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".EXEC84.2 001800* * EXEC84.2 001900**************************************************************** EXEC84.2 002000 CONFIGURATION SECTION. EXEC84.2 002100 EXEC84.2 002200 SPECIAL-NAMES. EXEC84.2 002300 INPUT-OUTPUT SECTION. EXEC84.2 002400 FILE-CONTROL. EXEC84.2 002500 SELECT OPTIONAL POPULATION-FILE EXEC84.2 002600 ASSIGN TO EXEC84.2 002700 XXXXX001. EXEC84.2 002800 SELECT SOURCE-COBOL-PROGRAMS EXEC84.2 002900 ASSIGN TO EXEC84.2 003000 XXXXX002 EXEC84.2 003100 ORGANIZATION SEQUENTIAL. EXEC84.2 003200 SELECT UPDATED-POPULATION-FILE EXEC84.2 003300 ASSIGN TO EXEC84.2 003400 XXXXX003. EXEC84.2 003500 SELECT PRINT-FILE EXEC84.2 003600 ASSIGN TO EXEC84.2 003700 XXXXX055. EXEC84.2 003800 SELECT CONTROL-CARD-FILE EXEC84.2 003900 ASSIGN TO EXEC84.2 004000 XXXXX058. EXEC84.2 004100 DATA DIVISION. EXEC84.2 004200 FILE SECTION. EXEC84.2 004300 FD POPULATION-FILE. EXEC84.2 004400* RECORD CONTAINS 2400 CHARACTERS. EXEC84.2 004500 01 SOURCE-IN-2400. EXEC84.2 004600 02 SOURCE-IN PIC X(80). EXEC84.2 004700* OCCURS 30. EXEC84.2 004800 FD CONTROL-CARD-FILE. EXEC84.2 004900 01 CONTROL-RECORD PIC X(80). EXEC84.2 005000 FD PRINT-FILE. EXEC84.2 005100 01 PRINT-REC. EXEC84.2 005200 05 FILLER PIC X. EXEC84.2 005300 05 PRINT-DATA PIC X(131). EXEC84.2 005400 FD SOURCE-COBOL-PROGRAMS EXEC84.2 005500 BLOCK CONTAINS 1 RECORDS. EXEC84.2 005600 01 CT-OUT. EXEC84.2 005700 02 FILLER PIC X(72). EXEC84.2 005800 02 FILLER PIC X(8). EXEC84.2 005900 FD UPDATED-POPULATION-FILE EXEC84.2 006000 RECORD CONTAINS 2400 CHARACTERS. EXEC84.2 006100 01 UPDATED-SOURCE-OUT-2400. EXEC84.2 006200 02 UD-SOURCE-OUT PIC X(80) OCCURS 30. EXEC84.2 006300 EXEC84.2 006400 WORKING-STORAGE SECTION. EXEC84.2 006500 EXEC84.2 006600 01 FILLER PIC X(40) VALUE EXEC84.2 006700 "NEWEXEC WORKING-STORAGE STARTS HERE ==->". EXEC84.2 006800 01 BLOCK-TYPE PIC X(5). EXEC84.2 006900 01 SUB1 PIC S9(3) COMP. EXEC84.2 007000 01 SUB2 PIC S9(3) COMP. EXEC84.2 007100 01 SUB3 PIC S9(3) COMP. EXEC84.2 007200 01 SUB4 PIC S9(3) COMP. EXEC84.2 007300 01 SUB5 PIC S9(3) COMP. EXEC84.2 007400 01 SUB6 PIC S9(3) COMP. EXEC84.2 007500 01 SUB7 PIC S9(3) COMP. EXEC84.2 007600 01 WA-ERR-IND PIC 9 VALUE ZEROES. EXEC84.2 007700 01 WA-FIRST-IND PIC 9 VALUE ZEROES. EXEC84.2 007800 01 WA-ZCARD-TABLE. EXEC84.2 007900 05 WA-ZCARD OCCURS 10 EXEC84.2 008000 PIC X(60). EXEC84.2 008100 01 WA-TOP-OF-PAGE-LINE. EXEC84.2 008200 05 FILLER PIC X(4) VALUE SPACES. EXEC84.2 008300 05 WA-VERSION. EXEC84.2 008400 07 WA-VERSION-TEXT PIC X(22) VALUE EXEC84.2 008500 "CCVS85 VERSION NUMBER ". EXEC84.2 008600 07 WA-VERSION-NUM PIC X(3) VALUE SPACES. EXEC84.2 008700 05 WA-RELEASE. EXEC84.2 008800 07 WA-RELEASE-TEXT PIC X(14) VALUE EXEC84.2 008900 ", RELEASED ON ". EXEC84.2 009000 07 WA-VERSION-DATE PIC X(11) VALUE SPACES. EXEC84.2 009100 05 FILLER PIC X(4) VALUE SPACES. EXEC84.2 009200 05 WA-COMPANY-AND-COMPILER PIC X(30) VALUE SPACES. EXEC84.2 009300 05 FILLER PIC X(5) VALUE SPACES. EXEC84.2 009400 05 WA-DATE PIC XXBXXBXX. EXEC84.2 009500 05 FILLER PIC X(4) VALUE SPACES. EXEC84.2 009600 05 FILLER PIC X(5) VALUE "PAGE ". EXEC84.2 009700 05 WA-PAGE-CT PIC Z(5)9. EXEC84.2 009800 EXEC84.2 009900 01 WA-ACCT-LINE-1. EXEC84.2 010000 05 FILLER PIC X(19) VALUE EXEC84.2 010100 " ** END OF PROGRAM ". EXEC84.2 010200 05 WA-CURRENT-PROG PIC X(6). EXEC84.2 010300 05 FILLER PIC X(32) VALUE EXEC84.2 010400 " FOUND, COBOL LINES PROCESSED: ". EXEC84.2 010500 05 WA-LINES-COBOL PIC Z(5)9. EXEC84.2 010600 01 WA-ACCT-LINE-2. EXEC84.2 010700 05 FILLER PIC X(19) VALUE EXEC84.2 010800 " ** LINES INSERTED ". EXEC84.2 010900 05 WA-LINES-INSERTED PIC Z(5)9. EXEC84.2 011000 05 FILLER PIC X(19) VALUE EXEC84.2 011100 " ** LINES REPLACED ". EXEC84.2 011200 05 WA-LINES-REPLACED PIC Z(5)9. EXEC84.2 011300 05 FILLER PIC X(19) VALUE EXEC84.2 011400 " ** LINES DELETED ". EXEC84.2 011500 05 WA-LINES-DELETED PIC Z(5)9. EXEC84.2 011600 01 WA-ACCT-LINE-3. EXEC84.2 011700 05 FILLER PIC X(18) VALUE EXEC84.2 011800 " ** OPTIONAL CODE ". EXEC84.2 011900 05 WA-OPTIONAL-CODE PIC X(8). EXEC84.2 012000 05 WA-CODE-REMOVED PIC Z(5)9. EXEC84.2 012100 05 WA-CODE-KILLED PIC X(21) VALUE EXEC84.2 012200 " ** COMMENTS DELETED ". EXEC84.2 012300 05 WA-COMMENTS-DEL PIC Z(5)9. EXEC84.2 012400 01 WA-FINAL-LINE-1. EXEC84.2 012500 05 FILLER PIC X(34) VALUE EXEC84.2 012600 " ** END OF POPULATION FILE REACHED". EXEC84.2 012700 05 FILLER PIC X(27) VALUE EXEC84.2 012800 " NUMBER OF PROGRAMS FOUND: ". EXEC84.2 012900 05 WA-PROGS-FOUND PIC Z(5)9. EXEC84.2 013000 01 WA-FINAL-LINE-2. EXEC84.2 013100 05 FILLER PIC X(47) VALUE EXEC84.2 013200 " ** NUMBER OF PROGRAMS WRITTEN TO SOURCE FILE: ". EXEC84.2 013300 05 WA-SOURCE-PROGS PIC Z(5)9. EXEC84.2 013400 01 WA-FINAL-LINE-3. EXEC84.2 013500 05 FILLER PIC X(48) VALUE EXEC84.2 013600 " ** NUMBER OF PROGRAMS WRITTEN TO NEW POPULATION". EXEC84.2 013700 05 FILLER PIC X(7) VALUE " FILE: ". EXEC84.2 013800 05 WA-NEWPOP-PROGS PIC Z(5)9. EXEC84.2 013900 01 WB-CONTROL-DATA. EXEC84.2 014000 05 WB-FILL PIC X(80). EXEC84.2 014100 05 FILLER REDEFINES WB-FILL. EXEC84.2 014200 10 WB-3 PIC X(3). EXEC84.2 014300 10 FILLER PIC X(77). EXEC84.2 014400 05 FILLER REDEFINES WB-FILL. EXEC84.2 014500 10 WB-4 PIC X(4). EXEC84.2 014600 10 WB-NN PIC 99. EXEC84.2 014700 10 FILLER PIC X. EXEC84.2 014800 10 WB-X PIC X. EXEC84.2 014900 10 FILLER PIC X(72). EXEC84.2 015000 05 FILLER REDEFINES WB-FILL. EXEC84.2 015100 10 WB-6 PIC X(6). EXEC84.2 015200 10 FILLER PIC X(74). EXEC84.2 015300 05 FILLER REDEFINES WB-FILL. EXEC84.2 015400 10 WB-7 PIC X(7). EXEC84.2 015500 10 FILLER PIC X(73). EXEC84.2 015600 05 FILLER REDEFINES WB-FILL. EXEC84.2 015700 10 WB-8 PIC X(8). EXEC84.2 015800 10 FILLER PIC X(72). EXEC84.2 015900 05 FILLER REDEFINES WB-FILL. EXEC84.2 016000 10 WB-9 PIC X(9). EXEC84.2 016100 10 FILLER PIC X(71). EXEC84.2 016200 05 FILLER REDEFINES WB-FILL. EXEC84.2 016300 10 WB-10 PIC X(10). EXEC84.2 016400 10 FILLER PIC X(70). EXEC84.2 016500 05 FILLER REDEFINES WB-FILL. EXEC84.2 016600 10 WB-11 PIC X(11). EXEC84.2 016700 10 FILLER PIC X(69). EXEC84.2 016800 05 FILLER REDEFINES WB-FILL. EXEC84.2 016900 10 WB-12 PIC X(12). EXEC84.2 017000 10 FILLER PIC X. EXEC84.2 017100 10 WB-PROG PIC X(5). EXEC84.2 017200 10 FILLER PIC X(62). EXEC84.2 017300 05 FILLER REDEFINES WB-FILL. EXEC84.2 017400 10 WB-13 PIC X(13). EXEC84.2 017500 10 FILLER PIC X(67). EXEC84.2 017600 05 FILLER REDEFINES WB-FILL. EXEC84.2 017700 10 WB-14 PIC X(14). EXEC84.2 017800 10 FILLER PIC X. EXEC84.2 017900 10 WB-MODULE PIC XX. EXEC84.2 018000 10 FILLER PIC X. EXEC84.2 018100 10 WB-LEVEL PIC X. EXEC84.2 018200 10 FILLER PIC X(61). EXEC84.2 018300 05 FILLER REDEFINES WB-FILL. EXEC84.2 018400 10 WB-15 PIC X(15). EXEC84.2 018500 10 FILLER PIC X(65). EXEC84.2 018600 05 FILLER REDEFINES WB-FILL. EXEC84.2 018700 10 WB-16 PIC X(16). EXEC84.2 018800 10 FILLER PIC X(64). EXEC84.2 018900 05 WB-X-CARD REDEFINES WB-FILL. EXEC84.2 019000 10 WB-X-HYPHEN PIC XX. EXEC84.2 019100 10 WB-X-CARD-NUM PIC 9(3). EXEC84.2 019200 10 WB-PROG-POS. EXEC84.2 019300 15 WB-PROG-POS-NUM PIC 99. EXEC84.2 019400 10 FILLER PIC X. EXEC84.2 019500 10 WB-SUBS-TEXT PIC X(60). EXEC84.2 019600 10 FILLER PIC X(12). EXEC84.2 019700 05 WB-START-CARD REDEFINES WB-FILL. EXEC84.2 019800 10 WB-STAR-START PIC X(6). EXEC84.2 019900 10 FILLER PIC X. EXEC84.2 020000 10 WB-UPDATE-PROG PIC X(6). EXEC84.2 020100 10 FILLER PIC X. EXEC84.2 020200 10 WB-RENUMBER PIC X. EXEC84.2 020300 10 FILLER PIC X(65). EXEC84.2 020400 05 WB-LINE-UPDATE REDEFINES WB-FILL. EXEC84.2 020500 10 WB-SEQ-1 PIC X(6). EXEC84.2 020600 10 WB-COBOL-LINE PIC X(74). EXEC84.2 020700 10 FILLER REDEFINES WB-COBOL-LINE. EXEC84.2 020800 15 WB-COL-7 PIC X. EXEC84.2 020900 15 FILLER PIC X(73). EXEC84.2 021000 10 FILLER REDEFINES WB-COBOL-LINE. EXEC84.2 021100 15 WB-CHAR PIC X. EXEC84.2 021200 15 WB-SEQ-2 PIC X(6). EXEC84.2 021300/ EXEC84.2 021400 01 WC-CURRENT-POP-RECORD. EXEC84.2 021500 05 WC-1. EXEC84.2 021600 10 WC-END-OF-POPFILE PIC X(16). EXEC84.2 021700 10 FILLER PIC X(64). EXEC84.2 021800 05 WC-HEADER REDEFINES WC-1. EXEC84.2 021900 10 WC-STAR-HEADER PIC X(7). EXEC84.2 022000 10 FILLER PIC X. EXEC84.2 022100 10 WC-COBOL PIC X(5). EXEC84.2 022200 10 FILLER PIC X. EXEC84.2 022300 10 WC-PROG-ID. EXEC84.2 022400 12 WC-PROG-ID-1-5. EXEC84.2 022500 15 WC-PROG-ID-1-4. EXEC84.2 022600 18 WC-MODULE PIC XX. EXEC84.2 022700 18 WC-LEVEL PIC X. EXEC84.2 022800 18 FILLER PIC X. EXEC84.2 022900 15 FILLER PIC X. EXEC84.2 023000 12 WC-PROG-ID-6 PIC X. EXEC84.2 023100 10 FILLER PIC X. EXEC84.2 023200 10 WC-SUBPRG PIC X(6). EXEC84.2 023300 10 FILLER PIC X. EXEC84.2 023400 10 WC-PROG2ID. EXEC84.2 023500 12 WC-PROG2ID-1-5 PIC X(5). EXEC84.2 023600 12 FILLER PIC X. EXEC84.2 023700 10 FILLER PIC X(46). EXEC84.2 023800 05 FILLER REDEFINES WC-1. EXEC84.2 023900 10 WC-1-72. EXEC84.2 024000 15 WC-6. EXEC84.2 024100 20 WC-STAR PIC X. EXEC84.2 024200 20 FILLER PIC X(5). EXEC84.2 024300 15 FILLER REDEFINES WC-6. EXEC84.2 024400 20 WC-1-5 PIC X(5). EXEC84.2 024500 20 FILLER PIC X. EXEC84.2 024600 15 WC-COL-7 PIC X. EXEC84.2 024700 15 WC-COL-8 PIC X. EXEC84.2 024800 15 FILLER PIC X(3). EXEC84.2 024900 15 WC-SUB-DATA. EXEC84.2 025000 20 WC-12-15 PIC X(4). EXEC84.2 025100 20 FILLER PIC X. EXEC84.2 025200 20 WC-17-19 PIC 9(3). EXEC84.2 025300 20 WC-20 PIC X. EXEC84.2 025400 20 FILLER PIC X(52). EXEC84.2 025500 10 WC-73-80 PIC X(8). EXEC84.2 025600 EXEC84.2 025700 01 WD-SOURCE-REC. EXEC84.2 025800 05 WD-1. EXEC84.2 025900 10 FILLER PIC X(6). EXEC84.2 026000 10 WD-HEADER PIC X(74). EXEC84.2 026100 EXEC84.2 026200 01 WE-PRINT-DATA. EXEC84.2 026300 05 WE-COBOL-LINE PIC X(80). EXEC84.2 026400 05 FILLER PIC X VALUE SPACE. EXEC84.2 026500 05 WE-X-CARD PIC X(9). EXEC84.2 026600 05 FILLER PIC XX VALUE SPACES. EXEC84.2 026700 05 WE-CHANGE-TYPE PIC X(12). EXEC84.2 026800 EXEC84.2 026900 01 WF-PROGRAM-SELECTED-TABLE. EXEC84.2 027000 05 WF-PROGRAM-SELECTED PIC X(5) OCCURS 50. EXEC84.2 027100 EXEC84.2 027200 01 WG-MODULE-SELECTED-TABLE. EXEC84.2 027300 05 FILLER OCCURS 10. EXEC84.2 027400 10 WG-MODULE-SELECTED PIC XX. EXEC84.2 027500 10 WG-MODULE-LEVEL PIC X. EXEC84.2 027600 EXEC84.2 027700 01 WV-PRINT-MISCELLANEOUS. EXEC84.2 027800 05 WV-OPTION-HEADING PIC X(25) VALUE EXEC84.2 027900 " OPTION SWITCH SETTINGS -". EXEC84.2 028000 05 WV-OPT-1 PIC X(40) VALUE EXEC84.2 028100 " 0 1 2". EXEC84.2 028200 05 WV-OPT-2 PIC X(52) VALUE EXEC84.2 028300 " 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6". EXEC84.2 028400 05 WV-OPT-SWITCHES. EXEC84.2 028500 10 FILLER PIC X VALUE SPACE. EXEC84.2 028600 10 FILLER OCCURS 26. EXEC84.2 028700 15 WV-OPT PIC X. EXEC84.2 028800 15 FILLER PIC X. EXEC84.2 028900 01 WX-X-CARD-TABLE. EXEC84.2 029000 05 WX-X-CARD OCCURS 200. EXEC84.2 029100 10 WX-X-CHAR PIC X EXEC84.2 029200 OCCURS 60. EXEC84.2 029300 01 WX-PROG-POS-TABLE. EXEC84.2 029400 05 WX-PROG-POS OCCURS 200 EXEC84.2 029500 PIC 99. EXEC84.2 029600 01 WY-SWITCHES. EXEC84.2 029700 05 WY-OPTION-SWITCHES. EXEC84.2 029800 10 WY-OPT-SW-1 PIC X. EXEC84.2 029900 10 WY-OPT-SW-2 PIC X. EXEC84.2 030000 10 WY-OPT-SW-3 PIC X. EXEC84.2 030100 10 WY-OPT-SW-4 PIC X. EXEC84.2 030200 10 WY-OPT-SW-5 PIC X. EXEC84.2 030300 10 WY-OPT-SW-6 PIC X. EXEC84.2 030400 10 WY-OPT-SW-7 PIC X. EXEC84.2 030500 10 WY-OPT-SW-8 PIC X. EXEC84.2 030600 10 WY-OPT-SW-9 PIC X. EXEC84.2 030700 10 WY-OPT-SW-10 PIC X. EXEC84.2 030800 10 WY-OPT-SW-11 PIC X. EXEC84.2 030900 10 WY-OPT-SW-12 PIC X. EXEC84.2 031000 10 WY-OPT-SW-13 PIC X. EXEC84.2 031100 10 WY-OPT-SW-14 PIC X. EXEC84.2 031200 10 WY-OPT-SW-15 PIC X. EXEC84.2 031300 10 WY-OPT-SW-16 PIC X. EXEC84.2 031400 10 WY-OPT-SW-17 PIC X. EXEC84.2 031500 10 WY-OPT-SW-18 PIC X. EXEC84.2 031600 10 WY-OPT-SW-19 PIC X. EXEC84.2 031700 10 WY-OPT-SW-20 PIC X. EXEC84.2 031800 10 WY-OPT-SW-21 PIC X. EXEC84.2 031900 10 WY-OPT-SW-22 PIC X. EXEC84.2 032000 10 WY-OPT-SW-23 PIC X. EXEC84.2 032100 10 WY-OPT-SW-24 PIC X. EXEC84.2 032200 10 WY-OPT-SW-25 PIC X. EXEC84.2 032300 10 WY-OPT-SW-26 PIC X. EXEC84.2 032400 05 FILLER REDEFINES WY-OPTION-SWITCHES.EXEC84.2 032500 10 WY-OPT-SW PIC X EXEC84.2 032600 OCCURS 26. EXEC84.2 032700 05 WY-PRINT-SWITCHES. EXEC84.2 032800 10 WY-EXTRACT-ALL PIC X. EXEC84.2 032900 10 WY-EXTRACT-AUTO PIC X. EXEC84.2 033000 10 WY-EXTRACT-MAN PIC X. EXEC84.2 033100 10 WY-KILL-DELETIONS PIC X. EXEC84.2 033200 10 WY-LIST-NO-UPDATES PIC X. EXEC84.2 033300 10 WY-LIST-X-CARDS PIC X. EXEC84.2 033400 10 WY-LIST-PROGRAMS PIC X. EXEC84.2 033500 10 WY-LIST-COMPACT PIC X. EXEC84.2 033600 10 WY-NO-DATA PIC X. EXEC84.2 033700 10 WY-NO-LIBRARY PIC X. EXEC84.2 033800 10 WY-NO-SOURCE PIC X. EXEC84.2 033900 10 WY-REMOVE-COMMENTS PIC X. EXEC84.2 034000 10 WY-NEW-POP PIC X. EXEC84.2 034100 10 WY-SELECT-PROG PIC X. EXEC84.2 034200 10 WY-SELECT-MODULE PIC X. EXEC84.2 034300 10 WY-SELECT-LEVEL PIC X. EXEC84.2 034400 EXEC84.2 034500 01 WZ-MISCELLANEOUS. EXEC84.2 034600 05 WZ-PROGRAM-SELECTED PIC X. EXEC84.2 034700 05 WZ-END-OF-POPFILE PIC X. EXEC84.2 034800 05 WZ-FULL-STOP PIC X. EXEC84.2 034900 05 WZ-DONT-READ-POPFILE PIC X. EXEC84.2 035000 05 WZ-UPDATE-THIS-PROG PIC X. EXEC84.2 035100 05 WZ-REPLACE-FLAG PIC X. EXEC84.2 035200 05 WZ-LINE-UPDATE PIC X. EXEC84.2 035300 05 WZ-RESEQUENCE-THIS PIC X. EXEC84.2 035400 05 WZ-RESEQUENCE-NEXT PIC X. EXEC84.2 035500 05 WZ-END-OF-UPDATES PIC X. EXEC84.2 035600 05 WZ-OPTIONAL-SELECTED PIC X. EXEC84.2 035700 05 WZ-DELETE-FLAG PIC X. EXEC84.2 035800 05 WZ-NOT-THIS-COMMENT PIC X. EXEC84.2 035900 05 WZ-CURRENT-HEADER PIC X(5). EXEC84.2 036000 05 WZ-INVALID-DATA. EXEC84.2 036100 10 FILLER PIC X(20). EXEC84.2 036200 10 WZ-ERROR-MESSAGE PIC X(60). EXEC84.2 036300 05 WZ-CURRENT-UPD-PROG. EXEC84.2 036400 10 WZ-UPD-PROG-CHAR PIC X. EXEC84.2 036500 10 FILLER PIC X(5). EXEC84.2 036600 05 WZ-CURRENT-MAIN-PROG. EXEC84.2 036700 10 WZ-MAIN-PROG-CHAR PIC X OCCURS 6. EXEC84.2 036800 05 WZ-PROG-BREAK. EXEC84.2 036900 10 WZ-1CHAR PIC X OCCURS 6. EXEC84.2 037000 05 WZ-CURRENT-POP-PROG. EXEC84.2 037100 10 FILLER PIC X(5). EXEC84.2 037200 10 WZ-PROG-ID-6 PIC X. EXEC84.2 037300 05 WZ-MAIN-PROG-FLAG PIC X. EXEC84.2 037400 05 WZ-LINES-COBOL PIC 9(6). EXEC84.2 037500 05 WZ-LINES-INSERTED PIC 9(6). EXEC84.2 037600 05 WZ-LINES-REPLACED PIC 9(6). EXEC84.2 037700 05 WZ-LINES-DELETED PIC 9(6). EXEC84.2 037800 05 WZ-COMMENTS-DELETED PIC 9(6). EXEC84.2 037900 05 WZ-CODE-REMOVED PIC 9(6). EXEC84.2 038000 05 WZ-SOURCE-PROGS PIC 9(6). EXEC84.2 038100 05 WZ-NEWPOP-PROGS PIC 9(6). EXEC84.2 038200 05 WZ-PROGS-FOUND PIC 9(6). EXEC84.2 038300 05 WZ-COMMENTS-DEL PIC 9(6). EXEC84.2 038400 05 WZ-SEQ-NO PIC 9(6). EXEC84.2 038500 05 WZ-SAVE-POP-RECORD. EXEC84.2 038600 10 WZ-SAVE-SEQ PIC X(6). EXEC84.2 038700 10 FILLER PIC X(5). EXEC84.2 038800 10 WZ-SAVE-12-20. EXEC84.2 038900 15 WZ-SAVE-12-15 PIC X(4). EXEC84.2 039000 15 FILLER PIC X(5). EXEC84.2 039100 10 FILLER PIC X(60). EXEC84.2 039200 05 WZ-PAGE-CT PIC 9(6). EXEC84.2 039300 05 WZ-LINE-CT PIC 9(6). EXEC84.2 039400 05 WZ-MODULE PIC XX. EXEC84.2 039500 05 WZ-LEVEL PIC X. EXEC84.2 039600 05 WZ-PRINT-HOLD PIC X(132). EXEC84.2 039700 05 WZ-X-CARD. EXEC84.2 039800 10 WZ-X-CHAR PIC X EXEC84.2 039900 OCCURS 60. EXEC84.2 040000 05 WZ-WITHIN-DELETE-SERIES-FLAG PIC X. EXEC84.2 040100 01 WZ-VERSION-CARD. EXEC84.2 040200 10 FILLER PIC X(55) VALUE EXEC84.2 040300 "CCVS85 VERSION 4.2 01 OCT 1992 0032 ". EXEC84.2 040400 01 WZ-VERSION-CONTROL REDEFINES WZ-VERSION-CARD. EXEC84.2 040500 10 FILLER PIC X(16). EXEC84.2 040600 10 WZ-VERSION-NUM PIC X(3). EXEC84.2 040700 10 FILLER PIC X(3). EXEC84.2 040800 10 WZ-VERSION-DATE PIC X(11). EXEC84.2 040900 EXEC84.2 041000/ EXEC84.2 041100 PROCEDURE DIVISION. EXEC84.2 041200*================== EXEC84.2 041300* EXEC84.2 041400 A10-MAIN SECTION. EXEC84.2 041500*================ EXEC84.2 041600* EXEC84.2 041700**************************************************************** EXEC84.2 041800* THIS IS THE HIGHEST LEVEL CONTROL MODULE * EXEC84.2 041900* * EXEC84.2 042000**************************************************************** EXEC84.2 042100 A10-1-MAIN. EXEC84.2 042200 PERFORM B10-INITIALISE. EXEC84.2 042300 EXEC84.2 042400 PERFORM C10-PROCESS-MONITOR. EXEC84.2 042500 EXEC84.2 042600 PERFORM D10-MERGE-UPDATE-CARDS. EXEC84.2 042700 EXEC84.2 042800 PERFORM E10-TERMINATE. EXEC84.2 042900 EXEC84.2 043000 A10-EXIT. EXEC84.2 043100 EXIT. EXEC84.2 043200 EXEC84.2 043300/ EXEC84.2 043400 B10-INITIALISE SECTION. EXEC84.2 043500*====================== EXEC84.2 043600* EXEC84.2 043700**************************************************************** EXEC84.2 043800* THIS SECTION INITIALIZES THE OPTION SWITCH AND X-CARD FIELDS * EXEC84.2 043900* PRIOR TO READING IN CONTROL CARD FILE. * EXEC84.2 044000* * EXEC84.2 044100* * EXEC84.2 044200* * EXEC84.2 044300* * EXEC84.2 044400**************************************************************** EXEC84.2 044500 B10-1-INIT-OPTION-SWITCHES. EXEC84.2 044600 MOVE SPACES TO WZ-MISCELLANEOUS. EXEC84.2 044700 MOVE SPACES TO WF-PROGRAM-SELECTED-TABLE. EXEC84.2 044800 MOVE SPACES TO WG-MODULE-SELECTED-TABLE. EXEC84.2 044900 MOVE SPACES TO WY-SWITCHES. EXEC84.2 045000 MOVE "A" TO WY-OPT-SW-1. EXEC84.2 045100 MOVE "E" TO WY-OPT-SW-2. EXEC84.2 045200 MOVE "H" TO WY-OPT-SW-3. EXEC84.2 045300 MOVE "L" TO WY-OPT-SW-4. EXEC84.2 045400 MOVE "Y" TO WY-OPT-SW-7. EXEC84.2 045500 MOVE "T" TO WY-OPT-SW-11. EXEC84.2 045600 EXEC84.2 045700 B10-2-INIT-X-CARDS. EXEC84.2 045800 MOVE ZERO TO SUB1. EXEC84.2 045900 MOVE ZERO TO SUB6. EXEC84.2 046000 MOVE ZERO TO SUB7. EXEC84.2 046100 MOVE 1 TO SUB5. EXEC84.2 046200 PERFORM B20-INIT-X-CARDS 200 TIMES. EXEC84.2 046300 MOVE " OMITTED" TO WX-X-CARD (84). EXEC84.2 046400 MOVE ZERO TO WZ-LINES-COBOL. EXEC84.2 046500 MOVE ZERO TO WZ-LINES-INSERTED. EXEC84.2 046600 MOVE ZERO TO WZ-LINES-REPLACED. EXEC84.2 046700 MOVE ZERO TO WZ-LINES-DELETED. EXEC84.2 046800 MOVE ZERO TO WZ-COMMENTS-DELETED. EXEC84.2 046900 MOVE ZERO TO WZ-CODE-REMOVED. EXEC84.2 047000 MOVE ZERO TO WZ-SOURCE-PROGS. EXEC84.2 047100 MOVE ZERO TO WZ-NEWPOP-PROGS. EXEC84.2 047200 MOVE ZERO TO WZ-PROGS-FOUND. EXEC84.2 047300 MOVE ZERO TO WZ-COMMENTS-DEL. EXEC84.2 047400 MOVE ZERO TO WZ-SEQ-NO. EXEC84.2 047500 MOVE ZERO TO WZ-PAGE-CT. EXEC84.2 047600 MOVE ZERO TO WZ-LINE-CT. EXEC84.2 047700 ACCEPT WA-DATE FROM DATE. EXEC84.2 047800 B10-EXIT. EXEC84.2 047900 EXIT. EXEC84.2 048000 EXEC84.2 048100 EXEC84.2 048200 EXEC84.2 048300 EXEC84.2 048400 B20-INIT-X-CARDS SECTION. EXEC84.2 048500*======================== EXEC84.2 048600 B20-1-INIT. EXEC84.2 048700 ADD 1 TO SUB1. EXEC84.2 048800 MOVE "**** X-CARD UNDEFINED ****" TO WX-X-CARD (SUB1). EXEC84.2 048900 MOVE ZERO TO WX-PROG-POS (SUB1). EXEC84.2 049000 EXEC84.2 049100 B20-EXIT. EXEC84.2 049200 EXIT. EXEC84.2 049300/ EXEC84.2 049400 C10-PROCESS-MONITOR SECTION. EXEC84.2 049500*=========================== EXEC84.2 049600 EXEC84.2 049700**************************************************************** EXEC84.2 049800* THIS SECTION PROCESSES THE RECORDS COMMENCING WITH "*" * EXEC84.2 049900* AND "X-" (THE MONITOR PART OF THE INPUT FILE ) AND READS * EXEC84.2 050000* THE FIRST "*START" UPDATE RECORD. * EXEC84.2 050100* * EXEC84.2 050200* PERFORMED BY A10-MAIN * EXEC84.2 050300* PERFORMS C20-PROCESS-STAR-CARDS * EXEC84.2 050400* C30-CHECK-COMBINATIONS * EXEC84.2 050500* C40-PROCESS-X-CARDS * EXEC84.2 050600**************************************************************** EXEC84.2 050700 C10-1-OPEN-FILES. EXEC84.2 050800 OPEN OUTPUT PRINT-FILE. EXEC84.2 050900 MOVE SPACES TO PRINT-REC. EXEC84.2 051000 OPEN INPUT CONTROL-CARD-FILE. EXEC84.2 051100 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 051200 AT END MOVE "CONTROL-CARD-FILE IS EMPTY" EXEC84.2 051300 TO PRINT-DATA EXEC84.2 051400 PERFORM X20-PRINT-DETAIL EXEC84.2 051500 STOP RUN. EXEC84.2 051600 PERFORM C20-PROCESS-STAR-CARDS EXEC84.2 051700 UNTIL WB-X-HYPHEN = "X-". EXEC84.2 051800 PERFORM C30-CHECK-COMBINATIONS. EXEC84.2 051900 PERFORM C40-PROCESS-X-CARDS EXEC84.2 052000 UNTIL WB-12 = "*END-MONITOR". EXEC84.2 052100 EXEC84.2 052200 PERFORM C50-PRINT-OPTIONS. EXEC84.2 052300 EXEC84.2 052400 C10-10-GET-FIRST-START-CARD. EXEC84.2 052500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 052600 AT END MOVE "NO BEGIN-UPDATE CARD FOUND" EXEC84.2 052700 TO PRINT-DATA EXEC84.2 052800 PERFORM X20-PRINT-DETAIL EXEC84.2 052900 STOP RUN. EXEC84.2 053000 IF WB-13 NOT = "*BEGIN-UPDATE" EXEC84.2 053100 MOVE "*BEGIN-UPDATE CARD MISSING" EXEC84.2 053200 TO PRINT-DATA EXEC84.2 053300 PERFORM X20-PRINT-DETAIL EXEC84.2 053400 STOP RUN. EXEC84.2 053500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 053600 AT END MOVE "NO END-UPDATE CARD FOUND" EXEC84.2 053700 TO PRINT-DATA EXEC84.2 053800 PERFORM X20-PRINT-DETAIL EXEC84.2 053900 STOP RUN. EXEC84.2 054000 IF WB-11 = "*END-UPDATE" EXEC84.2 054100 MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 054200 GO TO C10-EXIT. EXEC84.2 054300 IF WB-STAR-START = "*START" EXEC84.2 054400 PERFORM C60-START-CARD. EXEC84.2 054500 EXEC84.2 054600 C10-EXIT. EXEC84.2 054700 EXIT. EXEC84.2 054800/ EXEC84.2 054900 C20-PROCESS-STAR-CARDS SECTION. EXEC84.2 055000*============================== EXEC84.2 055100* EXEC84.2 055200**************************************************************** EXEC84.2 055300* THIS SECTION PROCESSES THE INPUT PARAMETER FILE RECORDS * EXEC84.2 055400* WHICH START WITH AN ASTERISK IN COLUMN 1 AND SETS VARIOUS * EXEC84.2 055500* FLAGS WHICH CONTROL THE WAY THIS EXECUTIVE ROUTINE WORKS. * EXEC84.2 055600* * EXEC84.2 055700* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 055800* PERFORMS C25-SET-FLAGS * EXEC84.2 055900**************************************************************** EXEC84.2 056000 C20-1-UPDATE-CHECK. EXEC84.2 056100 IF WB-13 = "*BEGIN-UPDATE" EXEC84.2 056200 MOVE WB-13 TO WZ-INVALID-DATA EXEC84.2 056300 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" EXEC84.2 056400 TO WZ-ERROR-MESSAGE EXEC84.2 056500 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 056600 PERFORM X20-PRINT-DETAIL EXEC84.2 056700 STOP RUN. EXEC84.2 056800 EXEC84.2 056900 IF WB-6 = "*START" EXEC84.2 057000 MOVE WB-6 TO WZ-INVALID-DATA EXEC84.2 057100 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" EXEC84.2 057200 TO WZ-ERROR-MESSAGE EXEC84.2 057300 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 057400 PERFORM X20-PRINT-DETAIL EXEC84.2 057500 STOP RUN. EXEC84.2 057600 EXEC84.2 057700 IF WB-11 = "*END-UPDATE" EXEC84.2 057800 MOVE WB-11 TO WZ-INVALID-DATA EXEC84.2 057900 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" EXEC84.2 058000 TO WZ-ERROR-MESSAGE EXEC84.2 058100 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 058200 PERFORM X20-PRINT-DETAIL EXEC84.2 058300 STOP RUN. EXEC84.2 058400 EXEC84.2 058500 PERFORM C25-SET-FLAGS. EXEC84.2 058600 EXEC84.2 058700 C20-EXIT. EXEC84.2 058800 EXIT. EXEC84.2 058900 EXEC84.2 059000/ EXEC84.2 059100 C25-SET-FLAGS SECTION. EXEC84.2 059200*===================== EXEC84.2 059300 C25-1. EXEC84.2 059400 MOVE WB-CONTROL-DATA TO PRINT-DATA. EXEC84.2 059500 PERFORM X20-PRINT-DETAIL. EXEC84.2 059600 IF WB-12 = "*EXTRACT-ALL" EXEC84.2 059700 MOVE "Y" TO WY-EXTRACT-ALL. EXEC84.2 059800 IF WB-13 = "*EXTRACT-AUTO" EXEC84.2 059900 MOVE "Y" TO WY-EXTRACT-AUTO. EXEC84.2 060000 IF WB-12 = "*EXTRACT-MAN" EXEC84.2 060100 MOVE "Y" TO WY-EXTRACT-MAN. EXEC84.2 060200 IF WB-15 = "*KILL-DELETIONS" EXEC84.2 060300 MOVE "Y" TO WY-KILL-DELETIONS. EXEC84.2 060400 IF WB-16 = "*LIST NO-UPDATES" EXEC84.2 060500 MOVE "Y" TO WY-LIST-NO-UPDATES. EXEC84.2 060600 IF WB-13 = "*LIST X-CARDS" EXEC84.2 060700 MOVE "Y" TO WY-LIST-X-CARDS. EXEC84.2 060800 IF WB-14 = "*LIST PROGRAMS" EXEC84.2 060900 MOVE "Y" TO WY-LIST-PROGRAMS. EXEC84.2 061000 IF WB-13 = "*LIST COMPACT" EXEC84.2 061100 MOVE "Y" TO WY-LIST-COMPACT. EXEC84.2 061200 IF WB-8 = "*NO-DATA" EXEC84.2 061300 MOVE "Y" TO WY-NO-DATA. EXEC84.2 061400 IF WB-11 = "*NO-LIBRARY" EXEC84.2 061500 MOVE "Y" TO WY-NO-LIBRARY. EXEC84.2 061600 IF WB-10 = "*NO-SOURCE" EXEC84.2 061700 MOVE "Y" TO WY-NO-SOURCE. EXEC84.2 061800 IF WB-16 = "*REMOVE-COMMENTS" EXEC84.2 061900 MOVE "Y" TO WY-REMOVE-COMMENTS. EXEC84.2 062000 IF WB-8 = "*NEW-POP" EXEC84.2 062100 MOVE "Y" TO WY-NEW-POP. EXEC84.2 062200 IF WB-4 = "*OPT" EXEC84.2 062300 MOVE WB-X TO WY-OPT-SW (WB-NN). EXEC84.2 062400 IF WB-14 = "*SELECT-MODULE" EXEC84.2 062500 IF WB-MODULE = SPACE EXEC84.2 062600 MOVE "SELECTED MODULE NOT SPECIFIED" EXEC84.2 062700 TO PRINT-DATA EXEC84.2 062800 PERFORM X20-PRINT-DETAIL EXEC84.2 062900 STOP RUN. EXEC84.2 063000 EXEC84.2 063100 IF WB-14 = "*SELECT-MODULE" EXEC84.2 063200 ADD 1 TO SUB6 EXEC84.2 063300 IF SUB6 > 10 EXEC84.2 063400 MOVE "MORE THAN 10 MODULES SELECTED" EXEC84.2 063500 TO PRINT-DATA EXEC84.2 063600 PERFORM X20-PRINT-DETAIL EXEC84.2 063700 STOP RUN EXEC84.2 063800 ELSE EXEC84.2 063900 MOVE "Y" TO WY-SELECT-MODULE EXEC84.2 064000 MOVE WB-MODULE EXEC84.2 064100 TO WG-MODULE-SELECTED (SUB6) EXEC84.2 064200 MOVE WB-LEVEL TO WG-MODULE-LEVEL (SUB6). EXEC84.2 064300 IF WB-12 = "*SELECT-PROG" EXEC84.2 064400 ADD 1 TO SUB7 EXEC84.2 064500 IF SUB7 > 50 EXEC84.2 064600 MOVE "MORE THAN 50 RECORDS SELECTED" EXEC84.2 064700 TO PRINT-DATA EXEC84.2 064800 PERFORM X20-PRINT-DETAIL EXEC84.2 064900 STOP RUN EXEC84.2 065000 ELSE EXEC84.2 065100 MOVE "Y" TO WY-SELECT-PROG EXEC84.2 065200 MOVE WB-PROG EXEC84.2 065300 TO WF-PROGRAM-SELECTED (SUB7). EXEC84.2 065400 EXEC84.2 065500 C25-10-READ-FILE. EXEC84.2 065600 MOVE SPACES TO WB-CONTROL-DATA. EXEC84.2 065700 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 065800 AT END MOVE "*END-MONITOR NOT ENCOUNTERED" EXEC84.2 065900 TO PRINT-DATA EXEC84.2 066000 PERFORM X20-PRINT-DETAIL EXEC84.2 066100 STOP RUN. EXEC84.2 066200 C25-EXIT. EXEC84.2 066300 EXIT. EXEC84.2 066400/ EXEC84.2 066500 C30-CHECK-COMBINATIONS SECTION. EXEC84.2 066600*============================== EXEC84.2 066700* EXEC84.2 066800**************************************************************** EXEC84.2 066900* THIS SECTION CHECKS FOR ANY INVALID COMBINATIONS OF * EXEC84.2 067000* CARDS INPUT WITH AN ASTERISK IN COLUMN 1. * EXEC84.2 067100* * EXEC84.2 067200* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 067300* PERFORMS NONE * EXEC84.2 067400**************************************************************** EXEC84.2 067500 C30-1-SELECTION-CHECK. EXEC84.2 067600 IF WY-EXTRACT-ALL = SPACE EXEC84.2 067700 GO TO C30-10. EXEC84.2 067800 IF WY-EXTRACT-AUTO = "Y" EXEC84.2 067900 MOVE "ALL AND AUTO PROGRAMS SELECTED" EXEC84.2 068000 TO PRINT-DATA EXEC84.2 068100 PERFORM X20-PRINT-DETAIL EXEC84.2 068200 STOP RUN. EXEC84.2 068300 EXEC84.2 068400 C30-10. EXEC84.2 068500 IF WY-EXTRACT-ALL = SPACE EXEC84.2 068600 GO TO C30-20. EXEC84.2 068700 IF WY-EXTRACT-MAN = "Y" EXEC84.2 068800 MOVE "ALL AND MANUAL PROGRAMS SELECTED" EXEC84.2 068900 TO PRINT-DATA EXEC84.2 069000 PERFORM X20-PRINT-DETAIL EXEC84.2 069100 STOP RUN. EXEC84.2 069200 EXEC84.2 069300 C30-20. EXEC84.2 069400 IF WY-LIST-PROGRAMS = SPACE EXEC84.2 069500 GO TO C30-30. EXEC84.2 069600 IF WY-LIST-NO-UPDATES = SPACE EXEC84.2 069700 MOVE "BOTH UPDATES AND PROGRAMS SELECTED" EXEC84.2 069800 TO PRINT-DATA EXEC84.2 069900 PERFORM X20-PRINT-DETAIL EXEC84.2 070000 STOP RUN. EXEC84.2 070100 EXEC84.2 070200 C30-30. EXEC84.2 070300 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 070400 GO TO C30-40-CHECK-FOR-NEW-FILE. EXEC84.2 070500 IF WY-EXTRACT-MAN = "Y" EXEC84.2 070600 MOVE "AUTO AND MANUAL PROGRAMS SELECTED" EXEC84.2 070700 TO PRINT-DATA EXEC84.2 070800 PERFORM X20-PRINT-DETAIL EXEC84.2 070900 STOP RUN. EXEC84.2 071000 EXEC84.2 071100 C30-40-CHECK-FOR-NEW-FILE. EXEC84.2 071200 IF WY-NO-SOURCE = SPACE EXEC84.2 071300 GO TO C30-50. EXEC84.2 071400 IF WY-NEW-POP = "Y" EXEC84.2 071500 GO TO C30-50. EXEC84.2 071600 MOVE "NO SOURCE OR UPDATED POPFILE SELECTED" TO PRINT-DATA.EXEC84.2 071700 PERFORM X20-PRINT-DETAIL EXEC84.2 071800 STOP RUN. EXEC84.2 071900 EXEC84.2 072000 C30-50. EXEC84.2 072100 IF WY-EXTRACT-ALL = "Y" EXEC84.2 072200 GO TO C30-55. EXEC84.2 072300 IF WY-EXTRACT-MAN = "Y" EXEC84.2 072400 GO TO C30-55. EXEC84.2 072500 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 072600 GO TO C30-60. EXEC84.2 072700 C30-55. EXEC84.2 072800 IF WY-SELECT-PROG = "Y" EXEC84.2 072900 MOVE "SINGLE PROGRAM SELECTED WITH ALL/AUTO/MANUAL" EXEC84.2 073000 TO PRINT-DATA EXEC84.2 073100 PERFORM X20-PRINT-DETAIL EXEC84.2 073200 STOP RUN. EXEC84.2 073300 IF WY-SELECT-MODULE = "Y" EXEC84.2 073400 MOVE "SINGLE MODULE SELECTED WITH ALL/AUTO/MANUAL" EXEC84.2 073500 TO PRINT-DATA EXEC84.2 073600 PERFORM X20-PRINT-DETAIL EXEC84.2 073700 STOP RUN. EXEC84.2 073800 EXEC84.2 073900 C30-60. EXEC84.2 074000 IF WY-SELECT-PROG = SPACE EXEC84.2 074100 GO TO C30-70. EXEC84.2 074200 IF WY-SELECT-MODULE = "Y" EXEC84.2 074300 MOVE "SINGLE MODULE AND SINGLE PROGRAM SELECTED" EXEC84.2 074400 TO PRINT-DATA EXEC84.2 074500 PERFORM X20-PRINT-DETAIL EXEC84.2 074600 STOP RUN. EXEC84.2 074700 EXEC84.2 074800 EXEC84.2 074900 C30-70. EXEC84.2 075000 IF WY-EXTRACT-ALL = SPACE EXEC84.2 075100 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 075200 IF WY-EXTRACT-MAN = SPACE EXEC84.2 075300 IF WY-SELECT-PROG = SPACE EXEC84.2 075400 IF WY-SELECT-MODULE = SPACE EXEC84.2 075500 MOVE "NO PROGRAMS SELECTED" EXEC84.2 075600 TO PRINT-DATA EXEC84.2 075700 PERFORM X20-PRINT-DETAIL EXEC84.2 075800 STOP RUN. EXEC84.2 075900 EXEC84.2 076000 C30-EXIT. EXEC84.2 076100 EXIT. EXEC84.2 076200/ EXEC84.2 076300 C40-PROCESS-X-CARDS SECTION. EXEC84.2 076400*=========================== EXEC84.2 076500* EXEC84.2 076600**************************************************************** EXEC84.2 076700* THIS SECTION PROCESSES THE INPUT PARAMETER FILE RECORDS * EXEC84.2 076800* WHICH START WITH AN "X" IN COLUMN 1 AND SETS A TABLE WHICH* EXEC84.2 076900* CONTAINS TEXT TO BE SUBSTITUTED BY THIS EXECUTIVE ROUTINE.* EXEC84.2 077000* * EXEC84.2 077100* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 077200* PERFORMS NONE * EXEC84.2 077300**************************************************************** EXEC84.2 077400 C40-1-PROCESS-CARD. EXEC84.2 077500 IF WB-X-HYPHEN NOT = "X-" EXEC84.2 077600 MOVE "INVALID X-CARD:" TO WZ-INVALID-DATA EXEC84.2 077700 MOVE WB-CONTROL-DATA TO WZ-ERROR-MESSAGE EXEC84.2 077800 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 077900 PERFORM X20-PRINT-DETAIL EXEC84.2 078000 GO TO C40-90-READ-FILE. EXEC84.2 078100 EXEC84.2 078200 IF WB-X-CARD-NUM > 200 EXEC84.2 078300 MOVE "INVALID X-CARD:" TO WZ-INVALID-DATA EXEC84.2 078400 MOVE WB-CONTROL-DATA TO WZ-ERROR-MESSAGE EXEC84.2 078500 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 078600 PERFORM X20-PRINT-DETAIL EXEC84.2 078700 GO TO C40-90-READ-FILE. EXEC84.2 078800 EXEC84.2 078900 C40-20-MOVE-DATA. EXEC84.2 079000 MOVE WB-SUBS-TEXT TO WX-X-CARD (WB-X-CARD-NUM). EXEC84.2 079100 IF WB-PROG-POS = SPACES EXEC84.2 079200 GO TO C40-30-MOVE-DATA. EXEC84.2 079300 IF WB-PROG-POS-NUM < 55 EXEC84.2 079400 MOVE WB-PROG-POS-NUM EXEC84.2 079500 TO WX-PROG-POS (WB-X-CARD-NUM). EXEC84.2 079600 EXEC84.2 079700 C40-30-MOVE-DATA. EXEC84.2 079800 MOVE WB-CONTROL-DATA TO PRINT-DATA. EXEC84.2 079900 PERFORM X20-PRINT-DETAIL. EXEC84.2 080000 EXEC84.2 080100 C40-90-READ-FILE. EXEC84.2 080200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 080300 AT END MOVE EXEC84.2 080400 "*BEGIN-UPDATE AND *END-UPDATE CARDS NOT ENCOUNTERED" EXEC84.2 080500 TO PRINT-DATA EXEC84.2 080600 PERFORM X20-PRINT-DETAIL EXEC84.2 080700 STOP RUN. EXEC84.2 080800 EXEC84.2 080900 C40-EXIT. EXEC84.2 081000 EXIT. EXEC84.2 081100 EXEC84.2 081200/ EXEC84.2 081300 C50-PRINT-OPTIONS SECTION. EXEC84.2 081400*========================= EXEC84.2 081500* EXEC84.2 081600**************************************************************** EXEC84.2 081700* THIS SECTION PRINTS DETAILS OF THE PROCESSING OPTIONS * EXEC84.2 081800* SELECTED BY THE VARIOUS CONTROL CARDS INPUT * EXEC84.2 081900* * EXEC84.2 082000* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 082100* PERFORMS NONE * EXEC84.2 082200**************************************************************** EXEC84.2 082300 C50-1-PRINT-OPTION-SWITCHES. EXEC84.2 082400 WRITE PRINT-REC FROM WV-OPTION-HEADING AFTER PAGE. EXEC84.2 082500 WRITE PRINT-REC FROM WV-OPT-1 AFTER 1. EXEC84.2 082600 WRITE PRINT-REC FROM WV-OPT-2 AFTER 1. EXEC84.2 082700 MOVE SPACES TO WV-OPT-SWITCHES. EXEC84.2 082800 MOVE ZERO TO SUB1. EXEC84.2 082900 PERFORM C50-4 26 TIMES. EXEC84.2 083000 GO TO C50-5. EXEC84.2 083100 C50-4. EXEC84.2 083200* PERFORM 26 TIMES EXEC84.2 083300 ADD 1 TO SUB1 EXEC84.2 083400 MOVE WY-OPT-SW (SUB1) TO WV-OPT (SUB1). EXEC84.2 083500* END-PERFORM. EXEC84.2 083600 C50-5. EXEC84.2 083700 WRITE PRINT-REC FROM WV-OPT-SWITCHES AFTER 1. EXEC84.2 083800 EXEC84.2 083900 C50-20-LISTING-OPTIONS. EXEC84.2 084000 IF WY-LIST-NO-UPDATES = "Y" EXEC84.2 084100 MOVE "UPDATES WILL NOT BE REPORTED" TO PRINT-DATA EXEC84.2 084200 ELSE EXEC84.2 084300 MOVE "UPDATES WILL BE REPORTED" TO PRINT-DATA. EXEC84.2 084400 WRITE PRINT-REC AFTER 3. EXEC84.2 084500 EXEC84.2 084600 IF WY-LIST-X-CARDS = "Y" EXEC84.2 084700 MOVE "X-CARD SUBSTITUTIONS WILL BE SHOWN" EXEC84.2 084800 TO PRINT-DATA EXEC84.2 084900 ELSE EXEC84.2 085000 MOVE "X-CARD SUBSTITUTIONS WILL NOT BE SHOWN" EXEC84.2 085100 TO PRINT-DATA. EXEC84.2 085200 WRITE PRINT-REC AFTER 1. EXEC84.2 085300 EXEC84.2 085400 IF WY-LIST-PROGRAMS = "Y" EXEC84.2 085500 MOVE "PROGRAM LISTINGS WILL BE PRINTED" EXEC84.2 085600 TO PRINT-DATA EXEC84.2 085700 ELSE EXEC84.2 085800 MOVE "PROGRAM LISTINGS WILL NOT BE PRINTED" EXEC84.2 085900 TO PRINT-DATA. EXEC84.2 086000 WRITE PRINT-REC AFTER 1. EXEC84.2 086100 EXEC84.2 086200 IF WY-LIST-COMPACT = "Y" EXEC84.2 086300 MOVE "REPORT WILL BE COMPRESSED" TO PRINT-DATA EXEC84.2 086400 ELSE EXEC84.2 086500 MOVE "REPORT WILL BE EXPANDED" TO PRINT-DATA. EXEC84.2 086600 WRITE PRINT-REC AFTER 1. EXEC84.2 086700 EXEC84.2 086800 IF WY-NO-SOURCE = "Y" EXEC84.2 086900 MOVE "SOURCE FILE WILL BE SUPPRESSED" TO PRINT-DATAEXEC84.2 087000 ELSE EXEC84.2 087100 MOVE "SOURCE FILE WILL BE CREATED" TO PRINT-DATA. EXEC84.2 087200 WRITE PRINT-REC AFTER 1. EXEC84.2 087300 EXEC84.2 087400 IF WY-NEW-POP = "Y" EXEC84.2 087500 MOVE "NEW POPULATION FILE WILL BE CREATED" EXEC84.2 087600 TO PRINT-DATA EXEC84.2 087700 ELSE EXEC84.2 087800 MOVE "NEW POPULATION FILE WILL BE SUPPRESSED" EXEC84.2 087900 TO PRINT-DATA. EXEC84.2 088000 WRITE PRINT-REC AFTER 1. EXEC84.2 088100 EXEC84.2 088200 EXEC84.2 088300 C50-30. EXEC84.2 088400 IF WY-NO-LIBRARY = "Y" EXEC84.2 088500 MOVE "LIBRARY NOT SELECTED" EXEC84.2 088600 TO PRINT-DATA EXEC84.2 088700 ELSE EXEC84.2 088800 MOVE "LIBRARY FILES WILL BE SELECTED" EXEC84.2 088900 TO PRINT-DATA. EXEC84.2 089000 WRITE PRINT-REC AFTER 1. EXEC84.2 089100 EXEC84.2 089200 C50-35. EXEC84.2 089300 IF WY-NO-DATA = "Y" EXEC84.2 089400 MOVE "DATA BLOCKS WILL BE IGNORED" EXEC84.2 089500 TO PRINT-DATA EXEC84.2 089600 ELSE EXEC84.2 089700 MOVE "DATA BLOCKS WILL BE SENT TO SOURCE FILE" EXEC84.2 089800 TO PRINT-DATA. EXEC84.2 089900 WRITE PRINT-REC AFTER 1. EXEC84.2 090000 EXEC84.2 090100 C50-40. EXEC84.2 090200 IF WY-EXTRACT-ALL = "Y" EXEC84.2 090300 MOVE "ALL PROGRAMS SELECTED" TO PRINT-DATA. EXEC84.2 090400 IF WY-EXTRACT-AUTO = "Y" EXEC84.2 090500 MOVE "ALL AUTOMATIC PROGRAMS SELECTED" EXEC84.2 090600 TO PRINT-DATA. EXEC84.2 090700 IF WY-EXTRACT-MAN = "Y" EXEC84.2 090800 MOVE "ALL MANUAL PROGRAMS SELECTED" EXEC84.2 090900 TO PRINT-DATA. EXEC84.2 091000 IF WY-SELECT-PROG = "Y" EXEC84.2 091100 MOVE "SEPARATE PROGRAMS SELECTED" EXEC84.2 091200 TO PRINT-DATA. EXEC84.2 091300 IF WY-SELECT-MODULE = "Y" EXEC84.2 091400 MOVE "SEPARATE MODULES SELECTED" EXEC84.2 091500 TO PRINT-DATA. EXEC84.2 091600 WRITE PRINT-REC AFTER 1. EXEC84.2 091700 EXEC84.2 091800 IF WY-REMOVE-COMMENTS = "Y" EXEC84.2 091900 MOVE "COMMENT LINES WILL BE REMOVED" EXEC84.2 092000 TO PRINT-DATA EXEC84.2 092100 ELSE EXEC84.2 092200 MOVE "COMMENT LINES WILL BE RETAINED" EXEC84.2 092300 TO PRINT-DATA. EXEC84.2 092400 WRITE PRINT-REC AFTER 1. EXEC84.2 092500 EXEC84.2 092600 EXEC84.2 092700 IF WY-KILL-DELETIONS = "Y" EXEC84.2 092800 MOVE "UNUSED OPTIONAL CODE WILL BE REMOVED" EXEC84.2 092900 TO PRINT-DATA EXEC84.2 093000 ELSE EXEC84.2 093100 MOVE "UNUSED OPTIONAL CODE WILL BE CONVERTED TO COMEXEC84.2 093200- "MENTS AND RETAINED" EXEC84.2 093300 TO PRINT-DATA. EXEC84.2 093400 WRITE PRINT-REC AFTER 1. EXEC84.2 093500 EXEC84.2 093600 C50-EXIT. EXEC84.2 093700 EXIT. EXEC84.2 093800 EXEC84.2 093900/ EXEC84.2 094000 C60-START-CARD SECTION. EXEC84.2 094100*====================== EXEC84.2 094200* EXEC84.2 094300**************************************************************** EXEC84.2 094400* WHEN A "*START" CARD IS READ THIS SECTION INITIALISES * EXEC84.2 094500* VARIOUS FIELDS AND SETS CERTAIN FLAGS. * EXEC84.2 094600* * EXEC84.2 094700* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 094800* D62-SERIES-UPDATE * EXEC84.2 094900* D67-LINE-UPDATE * EXEC84.2 095000* D68-LINE-EQUAL * EXEC84.2 095100* D69-LINE-BLANK-OR-LESS * EXEC84.2 095200* D40-ANY-UPDATES EXEC84.2 095300* PERFORMS NONE * EXEC84.2 095400**************************************************************** EXEC84.2 095500 C60-1. EXEC84.2 095600 EXEC84.2 095700 MOVE WB-UPDATE-PROG TO WZ-CURRENT-UPD-PROG. EXEC84.2 095800 EXEC84.2 095900 IF WZ-CURRENT-UPD-PROG = WZ-CURRENT-POP-PROG EXEC84.2 096000 MOVE "Y" TO WZ-UPDATE-THIS-PROG EXEC84.2 096100 ELSE EXEC84.2 096200 MOVE SPACE TO WZ-UPDATE-THIS-PROG. EXEC84.2 096300 EXEC84.2 096400 C60-EXIT. EXEC84.2 096500 EXIT. EXEC84.2 096600/ EXEC84.2 096700 D10-MERGE-UPDATE-CARDS SECTION. EXEC84.2 096800*============================== EXEC84.2 096900* EXEC84.2 097000**************************************************************** EXEC84.2 097100* THIS IS THE MAIN CONTROL SECTION FOR THE PROCESSING OF * EXEC84.2 097200* THE POPULATION FILE. IT OBTAINS THE HEADER FOR THE FIRST * EXEC84.2 097300* AUDIT ROUTINE IN THE POPFILE AND PROCESSES ALL RECORDS. * EXEC84.2 097400* * EXEC84.2 097500* PERFORMED BY A10-MAIN * EXEC84.2 097600* PERFORMS D11-GET-NEXT-PROGRAM * EXEC84.2 097700* D15-END-OF-POPFILE * EXEC84.2 097800* D20-PROCESS-POPFILE * EXEC84.2 097900**************************************************************** EXEC84.2 098000 D10-1-OPEN-FILES. EXEC84.2 098100 IF WY-NEW-POP = "Y" EXEC84.2 098200 OPEN OUTPUT UPDATED-POPULATION-FILE. EXEC84.2 098300 EXEC84.2 098400 IF WY-NO-SOURCE = SPACE EXEC84.2 098500 OPEN OUTPUT SOURCE-COBOL-PROGRAMS. EXEC84.2 098600 EXEC84.2 098700 OPEN INPUT POPULATION-FILE. EXEC84.2 098800 PERFORM D10-20-GET-VERSION. EXEC84.2 098900 MOVE WZ-VERSION-CARD TO PRINT-DATA. EXEC84.2 099000 PERFORM X20-PRINT-DETAIL. EXEC84.2 099100 EXEC84.2 099200 D10-10-GET-HEADER. EXEC84.2 099300 PERFORM D11-GET-NEXT-PROGRAM. EXEC84.2 099400 EXEC84.2 099500 PERFORM D20-PROCESS-POPFILE EXEC84.2 099600 UNTIL WZ-END-OF-POPFILE = "Y". EXEC84.2 099700 EXEC84.2 099800 PERFORM D15-END-OF-POPFILE. EXEC84.2 099900 EXEC84.2 100000 D10-EXIT. EXEC84.2 100100 EXIT. EXEC84.2 100200/ EXEC84.2 100300 D10-20-GET-VERSION SECTION. EXEC84.2 100400*============================ EXEC84.2 100500* EXEC84.2 100600 D10-20-INIT-VER. EXEC84.2 100700 MOVE WZ-VERSION-NUM TO WA-VERSION-NUM. EXEC84.2 100800 MOVE WZ-VERSION-DATE TO WA-VERSION-DATE. EXEC84.2 100900 EXEC84.2 101000 D10-20-EXIT. EXEC84.2 101100 EXIT. EXEC84.2 101200/ EXEC84.2 101300 D11-GET-NEXT-PROGRAM SECTION. EXEC84.2 101400*============================ EXEC84.2 101500* EXEC84.2 101600**************************************************************** EXEC84.2 101700* PERFORMED BY D10-MERGE-UPDATE-CARDS * EXEC84.2 101800* D30-PROCESS-HEADER * EXEC84.2 101900**************************************************************** EXEC84.2 102000 D11-1-READ-POPFILE. EXEC84.2 102100 MOVE SPACES TO WC-STAR-HEADER. EXEC84.2 102200 EXEC84.2 102300 PERFORM X30-READ-POPFILE EXEC84.2 102400 UNTIL WC-STAR-HEADER = "*HEADER". EXEC84.2 102500 D11-TEST-END. EXEC84.2 102600 IF WZ-END-OF-POPFILE = "Y" EXEC84.2 102700 GO TO D11-EXIT. EXEC84.2 102800 EXEC84.2 102900 IF WC-COBOL NOT = "COBOL" EXEC84.2 103000 IF WC-COBOL = "CLBRY" EXEC84.2 103100 IF WY-NO-LIBRARY = "Y" EXEC84.2 103200 GO TO D11-1-READ-POPFILE EXEC84.2 103300 ELSE EXEC84.2 103400 NEXT SENTENCE EXEC84.2 103500 ELSE EXEC84.2 103600 IF WC-COBOL = "DATA*" EXEC84.2 103700 IF WY-NO-DATA = "Y" EXEC84.2 103800 GO TO D11-1-READ-POPFILE EXEC84.2 103900 ELSE EXEC84.2 104000 NEXT SENTENCE EXEC84.2 104100 ELSE EXEC84.2 104200 GO TO D11-1-READ-POPFILE. EXEC84.2 104300 EXEC84.2 104400 D11-EXIT. EXEC84.2 104500 EXIT. EXEC84.2 104600/ EXEC84.2 104700 D15-END-OF-POPFILE SECTION. EXEC84.2 104800*========================== EXEC84.2 104900* EXEC84.2 105000**************************************************************** EXEC84.2 105100* THIS SECTION PRINTS END OF RUN ACCOUNTING INFORMATION AND * EXEC84.2 105200* FLAGS ANY OUTSTANDING *UPDATE RECORDS AS UNUSED. * EXEC84.2 105300* * EXEC84.2 105400* PERFORMED BY D10-MERGE-UPDATE-CARD * EXEC84.2 105500* PERFORMS D16-FLAG-UNUSED-UPDATES * EXEC84.2 105600* X20-PRINT-DETAIL * EXEC84.2 105700**************************************************************** EXEC84.2 105800 D15-1-SET-UP-FIELDS. EXEC84.2 105900 MOVE WZ-PROGS-FOUND TO WA-PROGS-FOUND. EXEC84.2 106000 MOVE WA-FINAL-LINE-1 TO PRINT-DATA. EXEC84.2 106100 PERFORM X20-PRINT-DETAIL. EXEC84.2 106200 EXEC84.2 106300 IF WY-NO-SOURCE = SPACE EXEC84.2 106400 MOVE WZ-SOURCE-PROGS TO WA-SOURCE-PROGS EXEC84.2 106500 MOVE WA-FINAL-LINE-2 TO PRINT-DATA EXEC84.2 106600 PERFORM X20-PRINT-DETAIL. EXEC84.2 106700 EXEC84.2 106800 IF WY-NEW-POP = "Y" EXEC84.2 106900 MOVE WZ-NEWPOP-PROGS TO WA-NEWPOP-PROGS EXEC84.2 107000 MOVE WA-FINAL-LINE-3 TO PRINT-DATA EXEC84.2 107100 PERFORM X20-PRINT-DETAIL. EXEC84.2 107200 EXEC84.2 107300 IF WZ-END-OF-UPDATES = SPACE EXEC84.2 107400 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 107500 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 107600 EXEC84.2 107700 PERFORM D16-FLAG-UNUSED-UPDATES EXEC84.2 107800 UNTIL WZ-END-OF-UPDATES = "Y". EXEC84.2 107900 EXEC84.2 108000 IF WY-SELECT-PROG = "Y" AND EXEC84.2 108100 WF-PROGRAM-SELECTED-TABLE NOT = SPACES EXEC84.2 108200 MOVE "SOME PROGRAMS NOT FOUND" TO PRINT-DATA EXEC84.2 108300 PERFORM X20-PRINT-DETAIL EXEC84.2 108400 PERFORM VARYING SUB7 FROM 1 BY 1 UNTIL SUB7 > 50 EXEC84.2 108500 IF WF-PROGRAM-SELECTED (SUB7) NOT = SPACE EXEC84.2 108600 MOVE WF-PROGRAM-SELECTED (SUB7) TO PRINT-DATA EXEC84.2 108700 PERFORM X20-PRINT-DETAIL EXEC84.2 108800 END-IF EXEC84.2 108900 END-PERFORM. EXEC84.2 109000 EXEC84.2 109100 D15-EXIT. EXEC84.2 109200 EXIT. EXEC84.2 109300 EXEC84.2 109400 EXEC84.2 109500 EXEC84.2 109600 EXEC84.2 109700 D16-FLAG-UNUSED-UPDATES SECTION. EXEC84.2 109800*=============================== EXEC84.2 109900 D16-1-PRINT-UPDATES. EXEC84.2 110000 MOVE WB-CONTROL-DATA TO PRINT-DATA. EXEC84.2 110100 PERFORM X20-PRINT-DETAIL. EXEC84.2 110200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 110300 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 110400 EXEC84.2 110500 D16-EXIT. EXEC84.2 110600 EXIT. EXEC84.2 110700 EXEC84.2 110800 EXEC84.2 110900/ EXEC84.2 111000 D20-PROCESS-POPFILE SECTION. EXEC84.2 111100*=========================== EXEC84.2 111200* EXEC84.2 111300**************************************************************** EXEC84.2 111400* THIS IS THE MAIN CONTROL SECTION FOR POPULATION FILE * EXEC84.2 111500* PROCESSING. * EXEC84.2 111600* * EXEC84.2 111700* PERFORMED BY D10-MERGE-UPDATE-CARDS * EXEC84.2 111800* PERFORMS D25-PRINT-REPORT * EXEC84.2 111900* D30-PROCESS-HEADER * EXEC84.2 112000* D90-PROCESS-END-OF * EXEC84.2 112100* X10-WRITE-UPDATED-POPFILE * EXEC84.2 112200* X30-READ-POPFILE * EXEC84.2 112300* X40-WRITE-SOURCE-FILE * EXEC84.2 112400**************************************************************** EXEC84.2 112500 D20-1-CHECK-RECORD-TYPE. EXEC84.2 112600 MOVE SPACE TO WZ-NOT-THIS-COMMENT. EXEC84.2 112700 MOVE SPACE TO WZ-LINE-UPDATE. EXEC84.2 112800 MOVE SPACE TO WZ-REPLACE-FLAG. EXEC84.2 112900* MOVE "Y" TO WZ-UPDATE-THIS-PROG. EXEC84.2 113000 MOVE SPACE TO WZ-OPTIONAL-SELECTED. EXEC84.2 113100 MOVE SPACE TO WZ-DELETE-FLAG. EXEC84.2 113200 EXEC84.2 113300 IF WC-STAR-HEADER = "*HEADER" EXEC84.2 113400 MOVE SPACE TO WZ-PROGRAM-SELECTED EXEC84.2 113500 PERFORM D30-PROCESS-HEADER EXEC84.2 113600 UNTIL WZ-PROGRAM-SELECTED = "Y" EXEC84.2 113700 ELSE EXEC84.2 113800 IF WC-STAR-HEADER = "*END-OF" EXEC84.2 113900 PERFORM D90-PROCESS-END-OF EXEC84.2 114000 ELSE EXEC84.2 114100 PERFORM D50-PROCESS-COBOL-LINE. EXEC84.2 114200 EXEC84.2 114300 PERFORM D25-PRINT-REPORT. EXEC84.2 114400 EXEC84.2 114500 D20-10-SOURCE-CHECK. EXEC84.2 114600 IF WY-NO-SOURCE = "Y" EXEC84.2 114700 GO TO D20-20-UPDATED-POP-CHECK. EXEC84.2 114800 IF WZ-DELETE-FLAG = "Y" EXEC84.2 114900 GO TO D20-20-UPDATED-POP-CHECK. EXEC84.2 115000 IF WZ-NOT-THIS-COMMENT = "Y" EXEC84.2 115100 GO TO D20-20-UPDATED-POP-CHECK. EXEC84.2 115200* IF WZ-UPDATE-THIS-PROG = SPACE EXEC84.2 115300* GO TO D20-30-READ-FILE. EXEC84.2 115400 EXEC84.2 115500 IF WZ-END-OF-POPFILE NOT = "Y" EXEC84.2 115600 PERFORM X40-WRITE-SOURCE-FILE. EXEC84.2 115700 EXEC84.2 115800 D20-20-UPDATED-POP-CHECK. EXEC84.2 115900 IF WY-NEW-POP = "Y" EXEC84.2 116000 PERFORM X10-WRITE-UPDATED-POPFILE. EXEC84.2 116100 MOVE WZ-SAVE-POP-RECORD TO WC-CURRENT-POP-RECORD. EXEC84.2 116200 EXEC84.2 116300 D20-30-READ-FILE. EXEC84.2 116400 IF WZ-END-OF-POPFILE = "Y" EXEC84.2 116500 GO TO D20-EXIT. EXEC84.2 116600 IF WB-SEQ-1 = SPACES EXEC84.2 116700 MOVE WZ-SAVE-SEQ TO WC-6 EXEC84.2 116800 GO TO D20-EXIT. EXEC84.2 116900 PERFORM X30-READ-POPFILE. EXEC84.2 117000 EXEC84.2 117100 D20-EXIT. EXEC84.2 117200 EXIT. EXEC84.2 117300 EXEC84.2 117400/ EXEC84.2 117500 D25-PRINT-REPORT SECTION. EXEC84.2 117600*======================== EXEC84.2 117700* EXEC84.2 117800**************************************************************** EXEC84.2 117900* DEPENDING ON THE PRINT OPTIONS SELECTED, THIS SECTION * EXEC84.2 118000* PRINTS EITHER THE EXTRACTED PROGRAMS OR ANY UPDATES AND * EXEC84.2 118100* X-CARD SUBSTITUTIONS MADE. * EXEC84.2 118200* * EXEC84.2 118300* PERFORMED BY D20-PROCESS-POPFILE * EXEC84.2 118400* PERFORMS X20-PRINT-DETAIL * EXEC84.2 118500* D27-PRINT-UPDATES * EXEC84.2 118600**************************************************************** EXEC84.2 118700 D25-1-CHECK-LIST-PROGRAMS. EXEC84.2 118800 IF WY-LIST-PROGRAMS = "Y" EXEC84.2 118900 MOVE WC-CURRENT-POP-RECORD TO PRINT-DATA EXEC84.2 119000 PERFORM X20-PRINT-DETAIL EXEC84.2 119100 GO TO D25-EXIT. EXEC84.2 119200 EXEC84.2 119300 D25-10-UPDATES-CHECK. EXEC84.2 119400 IF WY-LIST-NO-UPDATES = SPACE EXEC84.2 119500 IF WZ-LINE-UPDATE = "Y" EXEC84.2 119600 PERFORM D27-PRINT-UPDATES EXEC84.2 119700 GO TO D25-EXIT. EXEC84.2 119800 EXEC84.2 119900 D25-20-X-CARD-CHECK. EXEC84.2 120000 IF WY-LIST-X-CARDS = "Y" EXEC84.2 120100 IF WZ-SAVE-12-15 = "XXXX" EXEC84.2 120200 MOVE WZ-SAVE-12-20 TO WE-X-CARD EXEC84.2 120300 MOVE "SUBSTITUTION" TO WE-CHANGE-TYPE EXEC84.2 120400 MOVE WC-CURRENT-POP-RECORD EXEC84.2 120500 TO WE-COBOL-LINE EXEC84.2 120600 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 120700 PERFORM X20-PRINT-DETAIL. EXEC84.2 120800 EXEC84.2 120900 D25-EXIT. EXEC84.2 121000 EXIT. EXEC84.2 121100 EXEC84.2 121200 EXEC84.2 121300 EXEC84.2 121400/ EXEC84.2 121500 D27-PRINT-UPDATES SECTION. EXEC84.2 121600*========================= EXEC84.2 121700* EXEC84.2 121800**************************************************************** EXEC84.2 121900* THIS SECTION WILL PRINT THE ORIGINAL POPULATION FILE * EXEC84.2 122000* RECORD (IF "*LIST NO-UPDATES" HAS NOT BEEN SPECIFIED) AND,* EXEC84.2 122100* IF A REPLACEMENT, THE NEW IMAGE OR, IF AN INSERTION, JUST * EXEC84.2 122200* THE NEW LINE OF CODE. * EXEC84.2 122300* * EXEC84.2 122400* PERFORMED BY D25-PRINT-REPORT * EXEC84.2 122500* PERFORMS X20-PRINT-DETAIL * EXEC84.2 122600**************************************************************** EXEC84.2 122700 D27-1-PRINT-REPLACEMENTS. EXEC84.2 122800 IF WZ-REPLACE-FLAG = "Y" EXEC84.2 122900 MOVE WZ-SAVE-POP-RECORD TO WE-COBOL-LINE EXEC84.2 123000 MOVE SPACES TO WE-X-CARD EXEC84.2 123100 MOVE "ORIGINAL" TO WE-CHANGE-TYPE EXEC84.2 123200 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 123300 PERFORM X20-PRINT-DETAIL EXEC84.2 123400 MOVE "REPLACEMENT" TO WE-CHANGE-TYPE EXEC84.2 123500 MOVE SPACES TO WE-X-CARD EXEC84.2 123600 MOVE WC-CURRENT-POP-RECORD TO WE-COBOL-LINE EXEC84.2 123700 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 123800 PERFORM X20-PRINT-DETAIL EXEC84.2 123900 GO TO D27-EXIT. EXEC84.2 124000 EXEC84.2 124100 D27-10-PRINT-NEW-DATA. EXEC84.2 124200 IF WZ-DONT-READ-POPFILE = "Y" EXEC84.2 124300 MOVE WC-CURRENT-POP-RECORD TO WE-COBOL-LINE EXEC84.2 124400 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 124500 PERFORM X20-PRINT-DETAIL EXEC84.2 124600 GO TO D27-EXIT. EXEC84.2 124700 EXEC84.2 124800 D27-20-PRINT-DELETIONS. EXEC84.2 124900 IF WZ-DELETE-FLAG = "Y" EXEC84.2 125000 MOVE WZ-SAVE-POP-RECORD TO WE-COBOL-LINE EXEC84.2 125100 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 125200 PERFORM X20-PRINT-DETAIL. EXEC84.2 125300 EXEC84.2 125400 D27-EXIT. EXEC84.2 125500 EXIT. EXEC84.2 125600 EXEC84.2 125700/ EXEC84.2 125800 D30-PROCESS-HEADER SECTION. EXEC84.2 125900*========================== EXEC84.2 126000* EXEC84.2 126100**************************************************************** EXEC84.2 126200* THIS SECTION PROCESSES ANY "*HEADER" RECORDS. * EXEC84.2 126300* * EXEC84.2 126400* PERFORMED BY D20-PROCESS-POPFILE * EXEC84.2 126500* PERFORMS D90-PROCESS-END-OF * EXEC84.2 126600* D11-GET-NEXT-PROGRAM * EXEC84.2 126700* D31-PROCESS-DATA-HEADER * EXEC84.2 126800* D32-PROCESS-COBOL-HEADER * EXEC84.2 126900* D40-ANY-UPDATES * EXEC84.2 127000* X10-WRITE-UPDATED-POPFILE * EXEC84.2 127100* D43-PROGRAM-SELECTED * EXEC84.2 127200**************************************************************** EXEC84.2 127300 D30-1-CHECK-HEADER-TYPE. EXEC84.2 127400 MOVE WC-COBOL TO BLOCK-TYPE EXEC84.2 127500 IF WC-COBOL = "CLBRY" EXEC84.2 127600 AND WY-NO-LIBRARY NOT = "Y" EXEC84.2 127700 MOVE WC-HEADER TO PRINT-DATA EXEC84.2 127800 MOVE WC-PROG-ID TO WZ-CURRENT-MAIN-PROG EXEC84.2 127900 WZ-CURRENT-POP-PROG EXEC84.2 128000***************************************************************** EXEC84.2 128100* NOTE FOLLOWING CHANGES *** EXEC84.2 128200***************************************************************** EXEC84.2 128300* PERFORM D36-INITIALISE-PROGRAM-TOTALS EXEC84.2 128400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 128500 PERFORM D34-PROGRAM-SELECTED. EXEC84.2 128600 EXEC84.2 128700 IF WC-COBOL = "DATA*" EXEC84.2 128800 PERFORM D31-PROCESS-DATA-HEADER. EXEC84.2 128900 EXEC84.2 129000 IF WC-COBOL = "COBOL" EXEC84.2 129100 ADD 1 TO WZ-PROGS-FOUND EXEC84.2 129200 PERFORM D32-PROCESS-COBOL-HEADER. EXEC84.2 129300 EXEC84.2 129400 IF WZ-PROGRAM-SELECTED = "Y" EXEC84.2 129500 GO TO D30-20-HEADER-SELECTED. EXEC84.2 129600 EXEC84.2 129700 PERFORM D11-GET-NEXT-PROGRAM. EXEC84.2 129800 IF WZ-END-OF-POPFILE = "Y" EXEC84.2 129900 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 130000 GO TO D30-EXIT EXEC84.2 130100 ELSE EXEC84.2 130200 GO TO D30-1-CHECK-HEADER-TYPE. EXEC84.2 130300 EXEC84.2 130400 D30-20-HEADER-SELECTED. EXEC84.2 130500 MOVE WC-COBOL TO WZ-CURRENT-HEADER. EXEC84.2 130600 IF WZ-END-OF-UPDATES = SPACE EXEC84.2 130700 PERFORM D40-ANY-UPDATES. EXEC84.2 130800 EXEC84.2 130900 D30-EXIT. EXEC84.2 131000 EXIT. EXEC84.2 131100/ EXEC84.2 131200 D31-PROCESS-DATA-HEADER SECTION. EXEC84.2 131300*=============================== EXEC84.2 131400* EXEC84.2 131500 D31-1-CHECK-FOR-DATA-SELECTED. EXEC84.2 131600 IF WY-NO-DATA = "Y" EXEC84.2 131700 GO TO D31-EXIT. EXEC84.2 131800 EXEC84.2 131900 IF WZ-PROG-ID-6 = "M" EXEC84.2 132000 GO TO D31-30-MANUAL-CHECK. EXEC84.2 132100 EXEC84.2 132200 D31-20-AUTO-CHECK. EXEC84.2 132300 IF WY-EXTRACT-MAN = SPACE EXEC84.2 132400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 132500 ELSE EXEC84.2 132600 GO TO D31-EXIT. EXEC84.2 132700 EXEC84.2 132800 D31-30-MANUAL-CHECK. EXEC84.2 132900 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 133000 MOVE "Y" TO WZ-PROGRAM-SELECTED. EXEC84.2 133100 EXEC84.2 133200 EXEC84.2 133300 D31-EXIT. EXEC84.2 133400 EXIT. EXEC84.2 133500 EXEC84.2 133600/ EXEC84.2 133700 D32-PROCESS-COBOL-HEADER SECTION. EXEC84.2 133800*================================ EXEC84.2 133900* EXEC84.2 134000**************************************************************** EXEC84.2 134100* THIS SECTION CHECKS TO SEE IF THE CURRENT HEADER IS * EXEC84.2 134200* IS WITHIN THE RANGE SPECIFIED BY THE "*EXTRACT" OR * EXEC84.2 134300* "*SELECT" RECORDS OF THE INPUT CONTROL-FILE. * EXEC84.2 134400* * EXEC84.2 134500* PERFORMED BY D30-PROCESS-HEADER * EXEC84.2 134600* PERFORMS D33-MODULE-CHECK * EXEC84.2 134700* D34-PROGRAM-SELECTED * EXEC84.2 134800**************************************************************** EXEC84.2 134900* * EXEC84.2 135000**************************************************************** EXEC84.2 135100* IF PROGRAM DOES NOT END WITH '5','A','B' OR 'M' IT * EXEC84.2 135200* SHOULD HAVE A SPACE CHARACTER FOR POSITION 6. * EXEC84.2 135300**************************************************************** EXEC84.2 135400* * EXEC84.2 135500 D32-0-CHECK-A-OR-M. EXEC84.2 135600 IF WC-PROG-ID-6 = "A" EXEC84.2 135700 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 135800 IF WC-PROG-ID-6 = "B" EXEC84.2 135900 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 136000 IF WC-PROG-ID-6 = "M" EXEC84.2 136100 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 136200 IF WC-PROG-ID-6 = "5" EXEC84.2 136300 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 136400 MOVE SPACE TO WC-PROG-ID-6. EXEC84.2 136500 D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 136600 IF WY-EXTRACT-ALL = "Y" EXEC84.2 136700 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 136800 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 136900 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 137000 EXEC84.2 137100 D32-10-MANUAL-CHECK. EXEC84.2 137200 IF WY-EXTRACT-MAN = "Y" EXEC84.2 137300 IF WC-PROG-ID-6 = "M" EXEC84.2 137400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 137500 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 137600 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 137700 EXEC84.2 137800 D32-20-AUTO-CHECK. EXEC84.2 137900 IF WY-EXTRACT-AUTO = "Y" EXEC84.2 138000 IF WC-PROG-ID-6 = "A" OR "B" EXEC84.2 138100 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 138200 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 138300 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 138400 EXEC84.2 138500 D32-30-MODULE-CHECK. EXEC84.2 138600 IF WY-SELECT-MODULE = "Y" EXEC84.2 138700*THE FOLLOWING CHECK ASSUMES THAT THE FILES ON THE POPFILE EXEC84.2 138800*ARE IN ORDER! EXEC84.2 138900 IF WG-MODULE-SELECTED-TABLE = SPACES EXEC84.2 139000 MOVE "Y" TO WZ-END-OF-POPFILE EXEC84.2 139100 ELSE EXEC84.2 139200 MOVE 1 TO SUB6 EXEC84.2 139300 PERFORM D33-MODULE-CHECK EXEC84.2 139400 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 139500 EXEC84.2 139600 MOVE 1 TO SUB7. EXEC84.2 139700 D32-40-PROGRAM-CHECK. EXEC84.2 139800 IF WY-SELECT-PROG = "Y" EXEC84.2 139900 IF WF-PROGRAM-SELECTED-TABLE = SPACES EXEC84.2 140000 MOVE "Y" TO WZ-END-OF-POPFILE EXEC84.2 140100 ELSE EXEC84.2 140200 IF WC-PROG-ID-1-5 = WF-PROGRAM-SELECTED (SUB7) EXEC84.2 140300 MOVE SPACE TO WF-PROGRAM-SELECTED (SUB7) EXEC84.2 140400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 140500 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 140600 GO TO D32-50-CHECK-IF-SELECTED EXEC84.2 140700 ELSE EXEC84.2 140800 IF SUB7 < 50 EXEC84.2 140900 ADD 1 TO SUB7 EXEC84.2 141000 GO TO D32-40-PROGRAM-CHECK EXEC84.2 141100 ELSE EXEC84.2 141200 IF WC-SUBPRG = "SUBPRG" OR "SUBRTN" EXEC84.2 141300 MOVE 1 TO SUB7 EXEC84.2 141400 PERFORM 50 TIMES EXEC84.2 141500 IF WC-PROG2ID-1-5 = EXEC84.2 141600 WF-PROGRAM-SELECTED (SUB7) EXEC84.2 141700 MOVE SPACE TO EXEC84.2 141800 WF-PROGRAM-SELECTED (SUB7) EXEC84.2 141900 MOVE "Y" TO EXEC84.2 142000 WZ-PROGRAM-SELECTED EXEC84.2 142100 MOVE WC-PROG2ID TO EXEC84.2 142200 WZ-CURRENT-POP-PROG EXEC84.2 142300 GO D32-50-CHECK-IF-SELECTED EXEC84.2 142400 END-IF EXEC84.2 142500 ADD 1 TO SUB7 EXEC84.2 142600 END-PERFORM. EXEC84.2 142700 EXEC84.2 142800 D32-50-CHECK-IF-SELECTED. EXEC84.2 142900 IF WZ-PROGRAM-SELECTED = "Y" EXEC84.2 143000 PERFORM D34-PROGRAM-SELECTED. EXEC84.2 143100 EXEC84.2 143200 D32-EXIT. EXEC84.2 143300 EXIT. EXEC84.2 143400/ EXEC84.2 143500 D33-MODULE-CHECK SECTION. EXEC84.2 143600*======================== EXEC84.2 143700* EXEC84.2 143800**************************************************************** EXEC84.2 143900* IF ONE OR MORE MODULES HAVE BEEN SELECTED, THIS SECTION * EXEC84.2 144000* CHECKS THAT THE CURRENT POPULATION FILE PROGRAM IS FROM * EXEC84.2 144100* A SELECTED MODULE (AND LEVEL, IF LEVEL SELECTED). * EXEC84.2 144200* * EXEC84.2 144300* PERFORMED BY D32-PROCESS-COBOL-HEADER * EXEC84.2 144400* PERFORMS NONE * EXEC84.2 144500**************************************************************** EXEC84.2 144600 D33-1-MODULE-CHECK. EXEC84.2 144700 IF WC-MODULE = WG-MODULE-SELECTED (SUB6) EXEC84.2 144800 GO TO D33-10-CHECK-MODULE-LEVEL. EXEC84.2 144900 IF WC-MODULE > WG-MODULE-SELECTED (SUB6) AND EXEC84.2 145000*THE FOLLOWING CHECK MAKES SURE SOME FILES GET OFF EXEC84.2 145100 WZ-SOURCE-PROGS NOT = 0 EXEC84.2 145200 MOVE SPACE TO WG-MODULE-SELECTED (SUB6) EXEC84.2 145300 MOVE SPACE TO WG-MODULE-LEVEL (SUB6) EXEC84.2 145400 IF SUB6 < 10 EXEC84.2 145500 ADD 1 TO SUB6 EXEC84.2 145600 GO TO D33-1-MODULE-CHECK EXEC84.2 145700 ELSE EXEC84.2 145800 GO TO D33-EXIT EXEC84.2 145900 ELSE EXEC84.2 146000 GO TO D33-EXIT. EXEC84.2 146100 EXEC84.2 146200 D33-10-CHECK-MODULE-LEVEL. EXEC84.2 146300 IF WG-MODULE-LEVEL (SUB6) = SPACE EXEC84.2 146400 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 146500 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 146600 GO TO D33-EXIT. EXEC84.2 146700 EXEC84.2 146800 IF WG-MODULE-LEVEL (SUB6) = WC-LEVEL EXEC84.2 146900 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 147000 MOVE "Y" TO WZ-PROGRAM-SELECTED. EXEC84.2 147100 EXEC84.2 147200 D33-EXIT. EXEC84.2 147300 EXIT. EXEC84.2 147400 EXEC84.2 147500/ EXEC84.2 147600 D34-PROGRAM-SELECTED SECTION. EXEC84.2 147700*============================ EXEC84.2 147800* EXEC84.2 147900**************************************************************** EXEC84.2 148000* IF THE CURRENT POPULATION FILE PROGRAM HAS BEEN SELECTED * EXEC84.2 148100* FOR PROCESSING, THIS SECTION UPDATES VARIOUS FIELDS. * EXEC84.2 148200* * EXEC84.2 148300* PERFORMED BY D32-PROCESS-COBOL-HEADER * EXEC84.2 148400* PERFORMS NONE * EXEC84.2 148500**************************************************************** EXEC84.2 148600 D34-1-SELECTION-CHECK. EXEC84.2 148700 IF WZ-PROGRAM-SELECTED = SPACE EXEC84.2 148800 GO TO D34-EXIT. EXEC84.2 148900 EXEC84.2 149000 IF WY-NO-SOURCE = SPACE EXEC84.2 149100 ADD 1 TO WZ-SOURCE-PROGS. EXEC84.2 149200 EXEC84.2 149300 IF WY-NEW-POP = "Y" EXEC84.2 149400 ADD 1 TO WZ-NEWPOP-PROGS. EXEC84.2 149500 EXEC84.2 149600* MOVE SPACE TO WZ-CURRENT-MAIN-PROG. EXEC84.2 149700 MOVE WZ-CURRENT-POP-PROG TO WZ-CURRENT-MAIN-PROG. EXEC84.2 149800 EXEC84.2 149900 PERFORM D36-INITIALISE-PROGRAM-TOTALS. EXEC84.2 150000 EXEC84.2 150100 MOVE WC-HEADER TO PRINT-DATA. EXEC84.2 150200 IF WC-SUBPRG = "SUBPRG" EXEC84.2 150300 MOVE WZ-CURRENT-POP-PROG TO WZ-CURRENT-MAIN-PROG EXEC84.2 150400* MOVE WC-PROG2ID TO WZ-CURRENT-UPD-PROG EXEC84.2 150500 MOVE WC-PROG2ID TO WZ-CURRENT-POP-PROG EXEC84.2 150600 END-IF. EXEC84.2 150700 IF WC-SUBPRG = "SUBRTN" EXEC84.2 150800 MOVE WZ-CURRENT-POP-PROG TO WZ-CURRENT-MAIN-PROG EXEC84.2 150900* MOVE WC-PROG2ID TO WZ-CURRENT-UPD-PROG EXEC84.2 151000 MOVE WC-PROG2ID TO WZ-CURRENT-POP-PROG EXEC84.2 151100 END-IF. EXEC84.2 151200 EXEC84.2 151300 D34-2-OPEN-OUTPUT. EXEC84.2 151400 IF WY-LIST-COMPACT = SPACE EXEC84.2 151500 MOVE 51 TO WZ-LINE-CT. EXEC84.2 151600 EXEC84.2 151700 PERFORM X20-PRINT-DETAIL. EXEC84.2 151800 D34-EXIT. EXEC84.2 151900 EXIT. EXEC84.2 152000/ EXEC84.2 152100 D36-INITIALISE-PROGRAM-TOTALS SECTION. EXEC84.2 152200*===================================== EXEC84.2 152300* EXEC84.2 152400**************************************************************** EXEC84.2 152500* WHEN A PROGRAM "*HEADER" IS SELECTED THIS SECTION RESETS * EXEC84.2 152600* ALL THE VARIOUS TOTALS FOR THAT PROGRAM. * EXEC84.2 152700* * EXEC84.2 152800* PERFORMED BY D32-PROCESS-COBOL-HEADER * EXEC84.2 152900* PERFORMS NONE * EXEC84.2 153000**************************************************************** EXEC84.2 153100 D36-1-RESET-TOTALS. EXEC84.2 153200 MOVE ZERO TO WZ-LINES-COBOL. EXEC84.2 153300 MOVE ZERO TO WZ-LINES-INSERTED. EXEC84.2 153400 MOVE ZERO TO WZ-LINES-REPLACED. EXEC84.2 153500 MOVE ZERO TO WZ-LINES-DELETED. EXEC84.2 153600 MOVE ZERO TO WZ-CODE-REMOVED. EXEC84.2 153700 MOVE ZERO TO WZ-COMMENTS-DEL. EXEC84.2 153800 MOVE ZERO TO WZ-SEQ-NO. EXEC84.2 153900 EXEC84.2 154000 D36-EXIT. EXEC84.2 154100 EXIT. EXEC84.2 154200/ EXEC84.2 154300 D40-ANY-UPDATES SECTION. EXEC84.2 154400*======================= EXEC84.2 154500* EXEC84.2 154600**************************************************************** EXEC84.2 154700* THIS SECTION FINDS THE FIRST UPDATE RECORD (IF ANY) FOR * EXEC84.2 154800* THE CURRENT POPULATION FILE PROGRAM BEING PROCESSED. * EXEC84.2 154900* * EXEC84.2 155000* PERFORMED BY D30-PROCESS-HEADER * EXEC84.2 155100* PERFORMS D42-READ-UPDATE * EXEC84.2 155200**************************************************************** EXEC84.2 155300 D40-1-CHECK-UPDATE-AND-POP. EXEC84.2 155400 MOVE SPACE TO WZ-UPDATE-THIS-PROG. EXEC84.2 155500 IF WZ-CURRENT-UPD-PROG > WZ-CURRENT-POP-PROG EXEC84.2 155600 GO TO D40-EXIT. EXEC84.2 155700 EXEC84.2 155800 IF WZ-CURRENT-UPD-PROG = WZ-CURRENT-POP-PROG EXEC84.2 155900 GO TO D40-20-PROGRAMS-EQUAL. EXEC84.2 156000 EXEC84.2 156100* IF WZ-CURRENT-POP-PROG = WB-UPDATE-PROG EXEC84.2 156200* GO TO D40-20-PROGRAMS-EQUAL. EXEC84.2 156300 EXEC84.2 156400 IF WZ-UPD-PROG-CHAR = "A" EXEC84.2 156500 GO TO D40-05-CHECK-LIBRARY. EXEC84.2 156600 EXEC84.2 156700 IF WZ-UPD-PROG-CHAR = "K" EXEC84.2 156800 GO TO D40-05-CHECK-LIBRARY EXEC84.2 156900 ELSE GO TO D40-10-GET-NEXT-STAR-START. EXEC84.2 157000* EXEC84.2 157100 D40-05-CHECK-LIBRARY. EXEC84.2 157200 IF WZ-CURRENT-POP-PROG < "SQ000" EXEC84.2 157300 GO TO D40-EXIT. EXEC84.2 157400 EXEC84.2 157500 D40-10-GET-NEXT-STAR-START. EXEC84.2 157600 MOVE SPACES TO WB-STAR-START. EXEC84.2 157700 PERFORM D42-READ-UPDATE-FILE EXEC84.2 157800 UNTIL WB-STAR-START = "*START". EXEC84.2 157900 EXEC84.2 158000 IF WZ-END-OF-UPDATES = "Y" EXEC84.2 158100 GO TO D40-EXIT. EXEC84.2 158200 PERFORM C60-START-CARD. EXEC84.2 158300 EXEC84.2 158400 GO TO D40-1-CHECK-UPDATE-AND-POP. EXEC84.2 158500 EXEC84.2 158600 D40-20-PROGRAMS-EQUAL. EXEC84.2 158700 MOVE "Y" TO WZ-UPDATE-THIS-PROG. EXEC84.2 158800 IF WB-RENUMBER = "R" EXEC84.2 158900 MOVE "Y" TO WZ-RESEQUENCE-THIS EXEC84.2 159000 ELSE EXEC84.2 159100 MOVE SPACE TO WZ-RESEQUENCE-THIS. EXEC84.2 159200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 159300 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 159400 EXEC84.2 159500 IF WB-11 = "*END-UPDATE" EXEC84.2 159600 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 159700 EXEC84.2 159800 D40-EXIT. EXEC84.2 159900 EXIT. EXEC84.2 160000 EXEC84.2 160100/ EXEC84.2 160200 D42-READ-UPDATE-FILE SECTION. EXEC84.2 160300*============================ EXEC84.2 160400 D42-1. EXEC84.2 160500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 160600 AT END MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 160700 MOVE "*START" TO WB-STAR-START EXEC84.2 160800 GO TO D42-EXIT. EXEC84.2 160900 EXEC84.2 161000 IF WB-11 = "*END-UPDATE" EXEC84.2 161100 MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 161200 MOVE "*START" TO WB-STAR-START. EXEC84.2 161300 EXEC84.2 161400 D42-EXIT. EXEC84.2 161500 EXIT. EXEC84.2 161600 EXEC84.2 161700 EXEC84.2 161800 EXEC84.2 161900 EXEC84.2 162000 D50-PROCESS-COBOL-LINE SECTION. EXEC84.2 162100*============================== EXEC84.2 162200* EXEC84.2 162300**************************************************************** EXEC84.2 162400* THIS IS THE MAIN SECTION FOR PROCESSING THE COBOL SOURCE * EXEC84.2 162500* CODE OF THE POPULATION FILE * EXEC84.2 162600* * EXEC84.2 162700* * EXEC84.2 162800**************************************************************** EXEC84.2 162900 D50-1-CHECK-FOR-UPDATING. EXEC84.2 163000 EXEC84.2 163100 IF WZ-UPDATE-THIS-PROG = "Y" EXEC84.2 163200 PERFORM D60-PROCESS-UPDATE-CARD. EXEC84.2 163300 EXEC84.2 163400 IF WZ-DELETE-FLAG = "Y" EXEC84.2 163500 GO TO D50-EXIT. EXEC84.2 163600 EXEC84.2 163700 IF WY-NO-SOURCE = SPACE EXEC84.2 163800 IF BLOCK-TYPE NOT = "DATA*" EXEC84.2 163900 PERFORM D80-RAW-LINE. EXEC84.2 164000 EXEC84.2 164100 EXEC84.2 164200 D50-EXIT. EXEC84.2 164300 EXIT. EXEC84.2 164400/ EXEC84.2 164500 D60-PROCESS-UPDATE-CARD SECTION. EXEC84.2 164600*=============================== EXEC84.2 164700* EXEC84.2 164800**************************************************************** EXEC84.2 164900* THIS IS THE MAIN SECTION FOR PROCESSING ANY UPDATE CARDS * EXEC84.2 165000* WHICH EXIST FOR THE CURRENT POPULATION FILE PROGRAM * EXEC84.2 165100* BEING PROCESSED. * EXEC84.2 165200* * EXEC84.2 165300* PERFORMED BY D50-PROCESS-COBOL-LINE * EXEC84.2 165400* PERFORMS D67-LINE-UPDATE * EXEC84.2 165500* D62-SERIES-UPDATE * EXEC84.2 165600**************************************************************** EXEC84.2 165700 D60-1-CHECK-BLOCK-INSERT. EXEC84.2 165800 IF WB-SEQ-1 = SPACES EXEC84.2 165900 PERFORM D67-LINE-UPDATE EXEC84.2 166000 GO TO D60-30-CHECK-END. EXEC84.2 166100 EXEC84.2 166200 D60-10-CHECK-FOR-SERIES-UPDATE. EXEC84.2 166300 IF WB-SEQ-1 NOT NUMERIC EXEC84.2 166400 GO TO D60-30-CHECK-END. EXEC84.2 166500 EXEC84.2 166600 IF WB-SEQ-2 NUMERIC EXEC84.2 166700 PERFORM D62-SERIES-UPDATE EXEC84.2 166800 GO TO D60-30-CHECK-END EXEC84.2 166900 ELSE EXEC84.2 167000 PERFORM D67-LINE-UPDATE. EXEC84.2 167100 EXEC84.2 167200 D60-30-CHECK-END. EXEC84.2 167300 IF WB-11 = "*END-UPDATE" EXEC84.2 167400 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 167500 EXEC84.2 167600 EXEC84.2 167700 D60-EXIT. EXEC84.2 167800 EXIT. EXEC84.2 167900/ EXEC84.2 168000 D62-SERIES-UPDATE SECTION. EXEC84.2 168100*========================= EXEC84.2 168200* EXEC84.2 168300**************************************************************** EXEC84.2 168400* THIS SECTION WILL PROCESS SERIES INSERTIONS OR DELETIONS * EXEC84.2 168500* * EXEC84.2 168600* PERFORMED BY D60-PROCESS-UPDATE-CARD * EXEC84.2 168700* PERFORMS C60-START-CARD * EXEC84.2 168800**************************************************************** EXEC84.2 168900 D62-1-CHECK-FOR-WITHIN-RANGE. EXEC84.2 169000 IF WC-6 < WB-SEQ-1 EXEC84.2 169100 IF WZ-WITHIN-DELETE-SERIES-FLAG = "Y" EXEC84.2 169200* ALLOWS FOR OUT-OF-SEQUENCE LINE NUMBER WITHIN DELETE RANGE EXEC84.2 169300 GO TO D62-20-NOW-WITHIN-RANGE EXEC84.2 169400 END-IF EXEC84.2 169500 GO TO D62-EXIT. EXEC84.2 169600 EXEC84.2 169700 IF WC-6 NOT > WB-SEQ-2 EXEC84.2 169800 GO TO D62-20-NOW-WITHIN-RANGE. EXEC84.2 169900 EXEC84.2 170000 D62-10-READ-NEXT-UPDATE-CARD. EXEC84.2 170100 MOVE SPACES TO WZ-WITHIN-DELETE-SERIES-FLAG. EXEC84.2 170200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 170300 AT END MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 170400 GO TO D62-EXIT. EXEC84.2 170500 EXEC84.2 170600 IF WB-STAR-START = "*START" EXEC84.2 170700 PERFORM C60-START-CARD EXEC84.2 170800 GO TO D62-EXIT. EXEC84.2 170900 EXEC84.2 171000 IF WB-11 = "*END-UPDATE" EXEC84.2 171100 MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 171200 GO TO D62-EXIT. EXEC84.2 171300 EXEC84.2 171400 IF WB-SEQ-2 NUMERIC EXEC84.2 171500 GO TO D62-1-CHECK-FOR-WITHIN-RANGE. EXEC84.2 171600 PERFORM D67-LINE-UPDATE. EXEC84.2 171700 GO TO D62-EXIT. EXEC84.2 171800 EXEC84.2 171900 D62-20-NOW-WITHIN-RANGE. EXEC84.2 172000 MOVE "Y" TO WZ-LINE-UPDATE. EXEC84.2 172100 IF WB-COL-7 = "," EXEC84.2 172200 MOVE "Y" TO WZ-WITHIN-DELETE-SERIES-FLAG EXEC84.2 172300 ADD 1 TO WZ-LINES-DELETED EXEC84.2 172400 MOVE "Y" TO WZ-DELETE-FLAG EXEC84.2 172500 MOVE SPACES TO WE-X-CARD EXEC84.2 172600 MOVE "DELETIONS" TO WE-CHANGE-TYPE EXEC84.2 172700 IF WB-SEQ-1 = WB-SEQ-2 EXEC84.2 172800 MOVE SPACE TO WZ-WITHIN-DELETE-SERIES-FLAG EXEC84.2 172900 END-IF EXEC84.2 173000 GO TO D62-EXIT. EXEC84.2 173100 EXEC84.2 173200 MOVE "Y" TO WZ-REPLACE-FLAG. EXEC84.2 173300 MOVE WB-COL-7 TO WC-COL-7. EXEC84.2 173400 EXEC84.2 173500 D62-EXIT. EXEC84.2 173600 EXIT. EXEC84.2 173700 EXEC84.2 173800/ EXEC84.2 173900 D67-LINE-UPDATE SECTION. EXEC84.2 174000*======================= EXEC84.2 174100* EXEC84.2 174200**************************************************************** EXEC84.2 174300* THIS SECTION PERFORMS SINGLE LINE AMENDMENTS OR DELETIONS * EXEC84.2 174400* * EXEC84.2 174500* PERFORMED BY D60-PROCESS-UPDATE-CARD * EXEC84.2 174600* D62-SERIES-UPDATE * EXEC84.2 174700* PERFORMS C60-START-CARD * EXEC84.2 174800* D68-LINE-EQUAL * EXEC84.2 174900* D69-LINE-BLANK-OR-LESS * EXEC84.2 175000**************************************************************** EXEC84.2 175100 D67-1-CHECK-FOR-WITHIN-RANGE. EXEC84.2 175200 IF WC-6 < WB-SEQ-1 EXEC84.2 175300 GO TO D67-EXIT. EXEC84.2 175400 EXEC84.2 175500 D67-10-LINES-EQUAL-OR-LESS. EXEC84.2 175600 MOVE "Y" TO WZ-LINE-UPDATE. EXEC84.2 175700 IF WB-COL-7 = "," EXEC84.2 175800 ADD 1 TO WZ-LINES-DELETED EXEC84.2 175900 MOVE "Y" TO WZ-DELETE-FLAG EXEC84.2 176000 MOVE SPACES TO WE-X-CARD EXEC84.2 176100 MOVE "DELETION" TO WE-CHANGE-TYPE EXEC84.2 176200 GO TO D67-20-READ-CONTROL. EXEC84.2 176300 EXEC84.2 176400 IF WC-6 = WB-SEQ-1 EXEC84.2 176500 PERFORM D68-LINE-EQUAL EXEC84.2 176600 GO TO D67-EXIT. EXEC84.2 176700 EXEC84.2 176800 IF WB-SEQ-1 = SPACES EXEC84.2 176900 PERFORM D69-LINE-BLANK-OR-LESS EXEC84.2 177000 GO TO D67-EXIT. EXEC84.2 177100 EXEC84.2 177200 IF WC-6 > WB-SEQ-1 EXEC84.2 177300 PERFORM D69-LINE-BLANK-OR-LESS EXEC84.2 177400 GO TO D67-EXIT. EXEC84.2 177500 EXEC84.2 177600 D67-20-READ-CONTROL. EXEC84.2 177700 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 177800 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 177900 IF WB-STAR-START = "*START" EXEC84.2 178000 PERFORM C60-START-CARD. EXEC84.2 178100 EXEC84.2 178200 IF WB-11 = "*END-UPDATE" EXEC84.2 178300 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 178400 EXEC84.2 178500 D67-EXIT. EXEC84.2 178600 EXIT. EXEC84.2 178700/ EXEC84.2 178800 D68-LINE-EQUAL SECTION. EXEC84.2 178900*====================== EXEC84.2 179000* EXEC84.2 179100**************************************************************** EXEC84.2 179200* THIS SECTION IS PERFORMED WHEN THE SEQUENCE NUMBER OF A * EXEC84.2 179300* SINGLE UPDATE AMEND CARD IS THE SAME AS THE SEQUENCE * EXEC84.2 179400* NUMBER OF THE CURRENT POPULATION FILE LINE BEING PROCESSED* EXEC84.2 179500**************************************************************** EXEC84.2 179600* EXEC84.2 179700 D68-1. EXEC84.2 179800 MOVE WB-CONTROL-DATA TO WC-CURRENT-POP-RECORD. EXEC84.2 179900 ADD 1 TO WZ-LINES-REPLACED. EXEC84.2 180000 MOVE "Y" TO WZ-REPLACE-FLAG. EXEC84.2 180100 EXEC84.2 180200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 180300 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 180400 EXEC84.2 180500 IF WB-STAR-START = "*START" EXEC84.2 180600 PERFORM C60-START-CARD. EXEC84.2 180700 EXEC84.2 180800 IF WB-11 = "*END-UPDATE" EXEC84.2 180900 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 181000 EXEC84.2 181100 D68-EXIT. EXEC84.2 181200 EXIT. EXEC84.2 181300 EXEC84.2 181400 EXEC84.2 181500 EXEC84.2 181600 EXEC84.2 181700 D69-LINE-BLANK-OR-LESS SECTION. EXEC84.2 181800*============================== EXEC84.2 181900 D69-1. EXEC84.2 182000 MOVE WB-CONTROL-DATA TO WC-CURRENT-POP-RECORD. EXEC84.2 182100 ADD 1 TO WZ-LINES-INSERTED. EXEC84.2 182200 MOVE "Y" TO WZ-DONT-READ-POPFILE. EXEC84.2 182300 MOVE "INSERTIONS" TO WE-CHANGE-TYPE. EXEC84.2 182400 MOVE SPACES TO WE-X-CARD. EXEC84.2 182500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 182600 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 182700 EXEC84.2 182800 IF WB-STAR-START = "*START" EXEC84.2 182900 PERFORM C60-START-CARD. EXEC84.2 183000 EXEC84.2 183100 IF WB-11 = "*END-UPDATE" EXEC84.2 183200 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 183300 EXEC84.2 183400 D69-EXIT. EXEC84.2 183500 EXIT. EXEC84.2 183600 EXEC84.2 183700/ EXEC84.2 183800 D80-RAW-LINE SECTION. EXEC84.2 183900*==================== EXEC84.2 184000* EXEC84.2 184100**************************************************************** EXEC84.2 184200* IF COLUMN 7 OF THE POPULATION FILE PROGRAM CONTAINS A * EXEC84.2 184300* SPECIAL CHARACTER OR COLS. 12-16 CONTAIN X-CARD INFO., * EXEC84.2 184400* THIS SECTION WILL MAKE THE NECESSARY CHANGES. * EXEC84.2 184500* * EXEC84.2 184600* PERFORMED BY D50-PROCESS-COBOL-LINE * EXEC84.2 184700* PERFORMS D82-OPTIONAL-LETTER * EXEC84.2 184800* D86-X-CARD-CHECK * EXEC84.2 184900* X40-WRITE-SOURCE-FILE * EXEC84.2 185000**************************************************************** EXEC84.2 185100 D80-1-ASTERISK-CHECK. EXEC84.2 185200 IF WC-COL-7 = "D" GO TO D80-30-PRINT-LINE. EXEC84.2 185300 IF WC-COL-7 NOT = "*" EXEC84.2 185400 GO TO D80-20-ALPHABETIC-CHECK. EXEC84.2 185500 EXEC84.2 185600 IF WY-REMOVE-COMMENTS = "Y" EXEC84.2 185700 ADD 1 TO WZ-COMMENTS-DELETED EXEC84.2 185800 MOVE "Y" TO WZ-NOT-THIS-COMMENT EXEC84.2 185900 GO TO D80-EXIT. EXEC84.2 186000 EXEC84.2 186100 D80-20-ALPHABETIC-CHECK. EXEC84.2 186200 IF WC-COL-7 NOT ALPHABETIC EXEC84.2 186300 GO TO D80-30-PRINT-LINE. EXEC84.2 186400 EXEC84.2 186500 IF WC-COL-7 NOT = SPACE EXEC84.2 186600 PERFORM D82-OPTIONAL-LETTER. EXEC84.2 186700 EXEC84.2 186800 D80-30-PRINT-LINE. EXEC84.2 186900 IF WZ-DELETE-FLAG = SPACE EXEC84.2 187000 PERFORM D85-X-CARD-CHECK. EXEC84.2 187100 EXEC84.2 187200 D80-EXIT. EXEC84.2 187300 EXIT. EXEC84.2 187400 EXEC84.2 187500/ EXEC84.2 187600 D82-OPTIONAL-LETTER SECTION. EXEC84.2 187700*=========================== EXEC84.2 187800* EXEC84.2 187900 D82-1-SELECT-OPTIONAL. EXEC84.2 188000 PERFORM D83-CHECK-OPTION-SWITCHES EXEC84.2 188100 VARYING SUB4 FROM 1 BY 1 EXEC84.2 188200 UNTIL SUB4 > 26. EXEC84.2 188300 EXEC84.2 188400 IF WZ-OPTIONAL-SELECTED = "Y" EXEC84.2 188500 MOVE SPACE TO WC-COL-7 EXEC84.2 188600 GO TO D82-EXIT. EXEC84.2 188700 EXEC84.2 188800 D82-10-SAVE-OPTIONAL. EXEC84.2 188900 ADD 1 TO WZ-CODE-REMOVED. EXEC84.2 189000 IF WY-KILL-DELETIONS = "Y" EXEC84.2 189100 MOVE "Y" TO WZ-DELETE-FLAG EXEC84.2 189200 ELSE EXEC84.2 189300 MOVE WC-COL-7 TO WC-COL-8 EXEC84.2 189400 MOVE "*" TO WC-COL-7. EXEC84.2 189500 EXEC84.2 189600 D82-EXIT. EXEC84.2 189700 EXIT. EXEC84.2 189800 EXEC84.2 189900 EXEC84.2 190000 EXEC84.2 190100 EXEC84.2 190200 EXEC84.2 190300 D83-CHECK-OPTION-SWITCHES SECTION. EXEC84.2 190400*================================= EXEC84.2 190500* EXEC84.2 190600 D83-1-CHECK-SWITCH. EXEC84.2 190700 IF WY-OPT-SW (SUB4) = WC-COL-7 EXEC84.2 190800 MOVE 99 TO SUB4 EXEC84.2 190900 MOVE "Y" TO WZ-OPTIONAL-SELECTED. EXEC84.2 191000 EXEC84.2 191100 D83-EXIT. EXEC84.2 191200 EXIT. EXEC84.2 191300/ EXEC84.2 191400 D85-X-CARD-CHECK SECTION. EXEC84.2 191500*======================== EXEC84.2 191600* EXEC84.2 191700**************************************************************** EXEC84.2 191800* WHEN "XXXX" IS ENCOUNTERED IN COLUMNS 12 - 15 THIS * EXEC84.2 191900* SECTION EITHER SUBSTITUTES THE IMPLEMENTOR ASSIGNED TEXT * EXEC84.2 192000* OR MOVES THE PROGRAM NAME TO AN IMPLEMENTOR SPECIFIED * EXEC84.2 192100* POSITION IN THE PROGRAM CODE. * EXEC84.2 192200* * EXEC84.2 192300* PERFORMED BY D80-RAW-LINE * EXEC84.2 192400* PERFORMS D87-PROGRAM-NAME * EXEC84.2 192500* D86-REMOVE-FULL-STOP * EXEC84.2 192600* D86-INSERT-FULL-STOP * EXEC84.2 192700**************************************************************** EXEC84.2 192800 D85-1-CHECK-FOR-XXXXX. EXEC84.2 192900 IF WC-12-15 NOT = "XXXX" EXEC84.2 193000 GO TO D85-EXIT. EXEC84.2 193100 IF WC-17-19 NOT NUMERIC EXEC84.2 193200* XXXXX ENTRY IN POPULATION FILE IN ERROR. EXEC84.2 193300 GO TO D85-EXIT. EXEC84.2 193400 EXEC84.2 193500 D85-10-SUBSTITUTION-REQUIRED. EXEC84.2 193600 MOVE WC-17-19 TO SUB1. EXEC84.2 193700 MOVE WX-X-CARD (SUB1) TO WZ-X-CARD. EXEC84.2 193800 IF WX-PROG-POS (SUB1) NOT = ZERO EXEC84.2 193900 PERFORM D88-PROGRAM-NAME EXEC84.2 194000 GO TO D85-EXIT. EXEC84.2 194100 EXEC84.2 194200 D85-20-TEXT-SUBSTITUTION. EXEC84.2 194300 IF WC-20 = SPACE EXEC84.2 194400 PERFORM D86-REMOVE-FULL-STOP EXEC84.2 194500 VARYING SUB4 FROM 60 BY -1 EXEC84.2 194600 UNTIL SUB4 < 1 EXEC84.2 194700 MOVE WZ-X-CARD TO WC-SUB-DATA EXEC84.2 194800 GO TO D85-EXIT. EXEC84.2 194900 EXEC84.2 195000 IF WC-20 = "." EXEC84.2 195100 PERFORM D87-INSERT-FULL-STOP EXEC84.2 195200 VARYING SUB4 FROM 60 BY -1 EXEC84.2 195300 UNTIL SUB4 < 1 EXEC84.2 195400 MOVE WZ-X-CARD TO WC-SUB-DATA. EXEC84.2 195500 D85-EXIT. EXEC84.2 195600 EXIT. EXEC84.2 195700 EXEC84.2 195800/ EXEC84.2 195900 D86-REMOVE-FULL-STOP SECTION. EXEC84.2 196000*============================ EXEC84.2 196100* EXEC84.2 196200 D86-1. EXEC84.2 196300 IF WZ-X-CHAR (SUB4) = SPACE EXEC84.2 196400 GO TO D86-EXIT. EXEC84.2 196500 EXEC84.2 196600 IF WZ-X-CHAR (SUB4) = "." EXEC84.2 196700 MOVE SPACE TO WZ-X-CHAR (SUB4) EXEC84.2 196800 MOVE ZERO TO SUB4 EXEC84.2 196900 ELSE EXEC84.2 197000 MOVE ZERO TO SUB4. EXEC84.2 197100 EXEC84.2 197200 D86-EXIT. EXEC84.2 197300 EXIT. EXEC84.2 197400 EXEC84.2 197500 EXEC84.2 197600 EXEC84.2 197700 EXEC84.2 197800 EXEC84.2 197900 D87-INSERT-FULL-STOP SECTION. EXEC84.2 198000*============================ EXEC84.2 198100* EXEC84.2 198200 D87-1. EXEC84.2 198300 IF WZ-X-CHAR (SUB4) = SPACE EXEC84.2 198400 GO TO D87-EXIT. EXEC84.2 198500 EXEC84.2 198600 IF WZ-X-CHAR (SUB4) = "." EXEC84.2 198700 MOVE ZERO TO SUB4 EXEC84.2 198800 ELSE EXEC84.2 198900 ADD 1 TO SUB4 EXEC84.2 199000 MOVE "." TO WZ-X-CHAR (SUB4) EXEC84.2 199100 MOVE ZERO TO SUB4. EXEC84.2 199200 EXEC84.2 199300 D87-EXIT. EXEC84.2 199400 EXIT. EXEC84.2 199500/ EXEC84.2 199600 D88-PROGRAM-NAME SECTION. EXEC84.2 199700*======================== EXEC84.2 199800* EXEC84.2 199900 D88-1. EXEC84.2 200000 MOVE WX-PROG-POS (SUB1) TO SUB2. EXEC84.2 200100 MOVE SPACE TO WZ-MAIN-PROG-FLAG. EXEC84.2 200200 MOVE SPACE TO WZ-FULL-STOP. EXEC84.2 200300 IF WC-20 = "." EXEC84.2 200400 MOVE "Y" TO WZ-FULL-STOP. EXEC84.2 200500 EXEC84.2 200600 IF WX-X-CHAR (SUB1 SUB2) = "J" EXEC84.2 200700 MOVE WZ-CURRENT-MAIN-PROG TO WZ-PROG-BREAK EXEC84.2 200800 MOVE "Y" TO WZ-MAIN-PROG-FLAG EXEC84.2 200900 ELSE EXEC84.2 201000 MOVE WZ-CURRENT-POP-PROG TO WZ-PROG-BREAK. EXEC84.2 201100 EXEC84.2 201200 IF WZ-CURRENT-MAIN-PROG = SPACE EXEC84.2 201300 MOVE SPACE TO WZ-MAIN-PROG-FLAG. EXEC84.2 201400 EXEC84.2 201500 MOVE 1 TO SUB4. EXEC84.2 201600 PERFORM D89-MOVE-PROGRAM-NAME 6 TIMES. EXEC84.2 201700 EXEC84.2 201800 IF WZ-FULL-STOP = "Y" EXEC84.2 201900 PERFORM D87-INSERT-FULL-STOP EXEC84.2 202000 VARYING SUB4 FROM 60 BY -1 EXEC84.2 202100 UNTIL SUB4 < 1 EXEC84.2 202200 ELSE EXEC84.2 202300 PERFORM D86-REMOVE-FULL-STOP EXEC84.2 202400 VARYING SUB4 FROM 60 BY -1 EXEC84.2 202500 UNTIL SUB4 < 1. EXEC84.2 202600 EXEC84.2 202700 MOVE WZ-X-CARD TO WC-SUB-DATA. EXEC84.2 202800 EXEC84.2 202900 D88-EXIT. EXEC84.2 203000 EXIT. EXEC84.2 203100 EXEC84.2 203200 EXEC84.2 203300 EXEC84.2 203400 EXEC84.2 203500 D89-MOVE-PROGRAM-NAME SECTION. EXEC84.2 203600*============================= EXEC84.2 203700* EXEC84.2 203800 D89-1. EXEC84.2 203900* IF WZ-MAIN-PROG-FLAG = "Y" EXEC84.2 204000* MOVE WZ-MAIN-PROG-CHAR (SUB4) EXEC84.2 204100* TO WZ-X-CHAR (SUB2) EXEC84.2 204200* ELSE EXEC84.2 204300* MOVE WZ-UPD-PROG-CHAR (SUB4) EXEC84.2 204400* TO WZ-X-CHAR (SUB2). EXEC84.2 204500 EXEC84.2 204600 MOVE WZ-1CHAR(SUB4) TO WZ-X-CHAR(SUB2). EXEC84.2 204700 EXEC84.2 204800 IF SUB4 = 6 AND WZ-X-CHAR(SUB2) = SPACE EXEC84.2 204900 ADD 1 SUB2 GIVING SUB4 EXEC84.2 205000 PERFORM D89-2-CLOSE-SPACE UNTIL WZ-X-CHAR(SUB4) = EXEC84.2 205100 SPACE EXEC84.2 205200 MOVE SPACE TO WZ-X-CHAR(SUB2). EXEC84.2 205300 EXEC84.2 205400 ADD 1 TO SUB2. EXEC84.2 205500 ADD 1 TO SUB4. EXEC84.2 205600 EXEC84.2 205700 D89-EXIT. EXEC84.2 205800 EXIT. EXEC84.2 205900 EXEC84.2 206000 D89-2-CLOSE-SPACE SECTION. EXEC84.2 206100 D89-2-1. EXEC84.2 206200 EXEC84.2 206300 MOVE WZ-X-CHAR(SUB4) TO WZ-X-CHAR(SUB2). EXEC84.2 206400 ADD 1 TO SUB2 SUB4. EXEC84.2 206500 EXEC84.2 206600/ EXEC84.2 206700 D90-PROCESS-END-OF SECTION. EXEC84.2 206800*========================== EXEC84.2 206900* EXEC84.2 207000**************************************************************** EXEC84.2 207100* WHEN A "*END-OF"CARD IS ENCOUNTERED THIS SECTION PERFORMS * EXEC84.2 207200* THE END-OF-PROGRAMS ACTIONS. * EXEC84.2 207300* * EXEC84.2 207400* PERFORMED BY D20-PROCESS-POPFILE * EXEC84.2 207500* PERFORMS X10-WRITE-UPDATED-POP * EXEC84.2 207600**************************************************************** EXEC84.2 207700 D90-1-CHECK-HEADER-TYPE. EXEC84.2 207800 IF WY-KILL-DELETIONS = "Y" EXEC84.2 207900 MOVE "DELETED" TO WA-OPTIONAL-CODE EXEC84.2 208000 ELSE EXEC84.2 208100 MOVE "UNUSED " TO WA-OPTIONAL-CODE. EXEC84.2 208200 EXEC84.2 208300 MOVE WZ-CURRENT-POP-PROG TO WA-CURRENT-PROG EXEC84.2 208400 MOVE WZ-LINES-COBOL TO WA-LINES-COBOL EXEC84.2 208500 MOVE WZ-LINES-INSERTED TO WA-LINES-INSERTED EXEC84.2 208600 MOVE WZ-LINES-REPLACED TO WA-LINES-REPLACED EXEC84.2 208700 MOVE WZ-LINES-DELETED TO WA-LINES-DELETED EXEC84.2 208800 MOVE WZ-CODE-REMOVED TO WA-CODE-REMOVED EXEC84.2 208900 MOVE WZ-COMMENTS-DELETED TO WA-COMMENTS-DEL EXEC84.2 209000 MOVE WA-ACCT-LINE-1 TO PRINT-DATA EXEC84.2 209100 PERFORM X20-PRINT-DETAIL EXEC84.2 209200 MOVE WA-ACCT-LINE-2 TO PRINT-DATA EXEC84.2 209300 PERFORM X20-PRINT-DETAIL EXEC84.2 209400 MOVE WA-ACCT-LINE-3 TO PRINT-DATA EXEC84.2 209500 PERFORM X20-PRINT-DETAIL EXEC84.2 209600 EXEC84.2 209700 MOVE SPACES TO WZ-CURRENT-POP-PROG. EXEC84.2 209800* CLOSE SOURCE-COBOL-PROGRAMS. EXEC84.2 209900 EXEC84.2 210000 D90-EXIT. EXEC84.2 210100 EXIT. EXEC84.2 210200 EXEC84.2 210300 EXEC84.2 210400 D100-PROCESS-DATA. EXEC84.2 210500 EXIT. EXEC84.2 210600 EXEC84.2 210700/ EXEC84.2 210800 E10-TERMINATE SECTION. EXEC84.2 210900*===================== EXEC84.2 211000* EXEC84.2 211100**************************************************************** EXEC84.2 211200* THIS SECTION CLOSES ANY OPEN FILES * EXEC84.2 211300* * EXEC84.2 211400* * EXEC84.2 211500**************************************************************** EXEC84.2 211600 E10-1. EXEC84.2 211700 CLOSE PRINT-FILE. EXEC84.2 211800 EXEC84.2 211900 CLOSE CONTROL-CARD-FILE. EXEC84.2 212000 EXEC84.2 212100 IF WY-NEW-POP = "Y" EXEC84.2 212200 CLOSE UPDATED-POPULATION-FILE. EXEC84.2 212300 EXEC84.2 212400***************************************************************** EXEC84.2 212500 IF WY-NO-SOURCE = SPACE EXEC84.2 212600 CLOSE SOURCE-COBOL-PROGRAMS. EXEC84.2 212700 EXEC84.2 212800 CLOSE POPULATION-FILE. EXEC84.2 212900 STOP RUN. EXEC84.2 213000 E20-EXIT. EXEC84.2 213100 EXIT. EXEC84.2 213200 EXEC84.2 213300/ EXEC84.2 213400 X10-WRITE-UPDATED-POPFILE SECTION. EXEC84.2 213500*================================= EXEC84.2 213600* EXEC84.2 213700 X10-1-CHECK-FOR-NC114. EXEC84.2 213800* N.B. EXEC84.2 213900* NC114A HAS MISCELLANEOUS CHARACTERS IN COLUMNS 1-6 AND SO EXEC84.2 214000* SHOULD NOT BE RESEQUENCED BY THIS EXECUTIVE. EXEC84.2 214100 EXEC84.2 214200 IF WZ-CURRENT-POP-PROG = "NC114M" EXEC84.2 214300 GO TO X10-30-WRITE-FILE. EXEC84.2 214400 EXEC84.2 214500 X10-20-RENUMBER-CHECK. EXEC84.2 214600 IF WC-STAR = "*" EXEC84.2 214700 GO TO X10-30-WRITE-FILE. EXEC84.2 214800 IF WZ-RESEQUENCE-THIS = "Y" EXEC84.2 214900 ADD 100 TO WZ-SEQ-NO EXEC84.2 215000 MOVE WZ-SEQ-NO TO WC-6. EXEC84.2 215100 EXEC84.2 215200 X10-30-WRITE-FILE. EXEC84.2 215300 MOVE WC-CURRENT-POP-RECORD TO UD-SOURCE-OUT (SUB5). EXEC84.2 215400 ADD 1 TO SUB5. EXEC84.2 215500 IF SUB5 GREATER 30 EXEC84.2 215600 WRITE UPDATED-SOURCE-OUT-2400 EXEC84.2 215700 MOVE 1 TO SUB5 EXEC84.2 215800 MOVE SPACE TO UPDATED-SOURCE-OUT-2400. EXEC84.2 215900 EXEC84.2 216000 EXEC84.2 216100 X10-EXIT. EXEC84.2 216200 EXIT. EXEC84.2 216300 EXEC84.2 216400 EXEC84.2 216500/ EXEC84.2 216600 X20-PRINT-DETAIL SECTION. EXEC84.2 216700*======================== EXEC84.2 216800* EXEC84.2 216900 X20-1. EXEC84.2 217000 EXEC84.2 217100 IF WZ-LINE-CT > 50 EXEC84.2 217200 MOVE PRINT-REC TO WZ-PRINT-HOLD EXEC84.2 217300 ADD 1 TO WZ-PAGE-CT EXEC84.2 217400 MOVE WZ-PAGE-CT TO WA-PAGE-CT EXEC84.2 217500 MOVE WA-TOP-OF-PAGE-LINE EXEC84.2 217600 TO PRINT-REC EXEC84.2 217700 WRITE PRINT-REC AFTER PAGE EXEC84.2 217800 MOVE SPACE TO PRINT-REC EXEC84.2 217900 WRITE PRINT-REC EXEC84.2 218000 MOVE WZ-PRINT-HOLD TO PRINT-REC EXEC84.2 218100 MOVE ZERO TO WZ-LINE-CT. EXEC84.2 218200 ADD 1 TO WZ-LINE-CT. EXEC84.2 218300 EXEC84.2 218400 X20-2. EXEC84.2 218500 WRITE PRINT-REC AFTER 1. EXEC84.2 218600 MOVE SPACE TO PRINT-REC. EXEC84.2 218700 EXEC84.2 218800 X20-EXIT. EXEC84.2 218900 EXIT. EXEC84.2 219000/ EXEC84.2 219100 X30-READ-POPFILE SECTION. EXEC84.2 219200*======================== EXEC84.2 219300 X30-1. EXEC84.2 219400 IF WZ-DONT-READ-POPFILE = "Y" EXEC84.2 219500 MOVE SPACE TO WZ-DONT-READ-POPFILE EXEC84.2 219600 GO TO X30-EXIT. EXEC84.2 219700 EXEC84.2 219800* IF SUB1 GREATER THAN 30 EXEC84.2 219900 READ POPULATION-FILE INTO WC-CURRENT-POP-RECORD EXEC84.2 220000 AT END MOVE "Y" TO WZ-END-OF-POPFILE EXEC84.2 220100 MOVE "*HEADER" TO WC-STAR-HEADER EXEC84.2 220200 GO TO X30-EXIT. EXEC84.2 220300 MOVE WC-CURRENT-POP-RECORD TO WZ-SAVE-POP-RECORD. EXEC84.2 220400 EXEC84.2 220500 IF WC-STAR = "*" EXEC84.2 220600 IF WZ-CURRENT-HEADER = "COBOL" EXEC84.2 220700 IF WC-1-5 = "ABCDE" EXEC84.2 220800 ADD 1 TO WZ-LINES-COBOL EXEC84.2 220900 ELSE EXEC84.2 221000 IF WC-1-5 = "*/+(>" EXEC84.2 221100 ADD 1 TO WZ-LINES-COBOL EXEC84.2 221200 ELSE EXEC84.2 221300 IF WC-1-5 = "999-9" EXEC84.2 221400 ADD 1 TO WZ-LINES-COBOL EXEC84.2 221500 ELSE EXEC84.2 221600 IF WC-1-5 = "Z=.,;" EXEC84.2 221700 ADD 1 TO WZ-LINES-COBOL EXEC84.2 221800 ELSE EXEC84.2 221900 IF WC-1-5 = ")14$ " EXEC84.2 222000 ADD 1 TO WZ-LINES-COBOL EXEC84.2 222100 ELSE EXEC84.2 222200 IF WC-1-5 = " 23 " EXEC84.2 222300 ADD 1 TO WZ-LINES-COBOL EXEC84.2 222400 ELSE EXEC84.2 222500 NEXT SENTENCE EXEC84.2 222600 ELSE EXEC84.2 222700 NEXT SENTENCE EXEC84.2 222800 ELSE EXEC84.2 222900 IF WZ-CURRENT-HEADER = "COBOL" EXEC84.2 223000 ADD 1 TO WZ-LINES-COBOL. EXEC84.2 223100 EXEC84.2 223200* MOVE SOURCE-IN (SUB1) TO WC-CURRENT-POP-RECORD. EXEC84.2 223300* ADD 1 TO SUB1. EXEC84.2 223400 EXEC84.2 223500 EXEC84.2 223600 X30-EXIT. EXEC84.2 223700 EXIT. EXEC84.2 223800 EXEC84.2 223900 EXEC84.2 224000 EXEC84.2 224100 EXEC84.2 224200 EXEC84.2 224300 X40-WRITE-SOURCE-FILE SECTION. EXEC84.2 224400*= =========================== EXEC84.2 224500 X40-1. EXEC84.2 224600 MOVE SPACES TO WD-1. EXEC84.2 224700* IF BLOCK-TYPE NOT = "DATA*" EXEC84.2 224800* MOVE SPACES TO WC-73-80. EXEC84.2 224900 IF WC-STAR = "*" EXEC84.2 225000 IF WC-1-5 = "*/+(>" EXEC84.2 225100 WRITE CT-OUT FROM WC-CURRENT-POP-RECORD EXEC84.2 225200 ELSE EXEC84.2 225300 MOVE WC-CURRENT-POP-RECORD TO WD-HEADER EXEC84.2 225400 WRITE CT-OUT FROM WD-SOURCE-REC EXEC84.2 225500 ELSE EXEC84.2 225600 WRITE CT-OUT FROM WC-CURRENT-POP-RECORD. EXEC84.2 225700 EXEC84.2 225800 X40-EXIT. EXEC84.2 225900 EXIT. EXEC84.2 226000 EXEC84.2 *END-OF,EXEC85 *HEADER,CLBRY,ALTL1 000100* THIS TEXT MUST BE PLACED IN THE LIBRARY WHOSE NAME IS ALTL14.2 000200* EQUATED TO THE X-48 (XXXXX048) CARD. ALTL14.2 000300 PERFORM FAIL. ALTL14.2 000400 SUBTRACT 1 FROM ERROR-COUNTER. ALTL14.2 000500 MOVE "TEXT COPIED FROM WRONG LIBRARY" TO RE-MARK. ALTL14.2 *END-OF,ALTL1 *HEADER,CLBRY,ALTLB 000100* THIS TEXT MUST BE PLACED IN THE LIBRARY WHOSE NAME IS ALTLB4.2 000200* EQUATED TO THE X-47 (XXXXX047) CARD. ALTLB4.2 000300 MOVE SPACES TO RE-MARK. ALTLB4.2 000400 PERFORM PASS. ALTLB4.2 000500 SUBTRACT 1 FROM ERROR-COUNTER. ALTLB4.2 *END-OF,ALTLB *HEADER,COBOL,CM101M 000100 IDENTIFICATION DIVISION. CM1014.2 000200 PROGRAM-ID. CM1014.2 000300 CM101M. CM1014.2 000400 AUTHOR. CM1014.2 000500 FEDERAL COMPILER TESTING CENTER. CM1014.2 000600 INSTALLATION. CM1014.2 000700 GENERAL SERVICES ADMINISTRATION CM1014.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1014.2 000900 SOFTWARE DEVELOPMENT OFFICE. CM1014.2 001000 5203 LEESBURG PIKE SUITE 1100 CM1014.2 001100 FALLS CHURCH VIRGINIA 22041. CM1014.2 001200 CM1014.2 001300 PHONE (703) 756-6153 CM1014.2 001400 CM1014.2 001500 " HIGH ". CM1014.2 001600 DATE-WRITTEN. CM1014.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1014.2 001800 CREATION DATE / VALIDATION DATE CM1014.2 001900 "4.2 ". CM1014.2 002000 SECURITY. CM1014.2 002100 NONE. CM1014.2 002200 ENVIRONMENT DIVISION. CM1014.2 002300 CONFIGURATION SECTION. CM1014.2 002400 SOURCE-COMPUTER. CM1014.2 002500 XXXXX082. CM1014.2 002600 OBJECT-COMPUTER. CM1014.2 002700 XXXXX083. CM1014.2 002800 INPUT-OUTPUT SECTION. CM1014.2 002900 FILE-CONTROL. CM1014.2 003000 SELECT PRINT-FILE ASSIGN TO CM1014.2 003100 XXXXX055. CM1014.2 003200 DATA DIVISION. CM1014.2 003300 FILE SECTION. CM1014.2 003400 FD PRINT-FILE CM1014.2 003500 LABEL RECORDS CM1014.2 003600 XXXXX084 CM1014.2 003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1014.2 003800 01 PRINT-REC PICTURE X(120). CM1014.2 003900 01 DUMMY-RECORD PICTURE X(120). CM1014.2 004000 WORKING-STORAGE SECTION. CM1014.2 004100 77 PASSWORD1 PIC X(10) VALUE CM1014.2 004200 XXXXX031. CM1014.2 004300 77 DISABLE-STATUS PIC XX VALUE "99". CM1014.2 004400 77 POLL-COUNT PIC 9(8). CM1014.2 004500 77 INIT-TIME PIC 9(8). CM1014.2 004600 77 COMP-TIME PIC 9(8). CM1014.2 004700 01 SYSTEM-TIME. CM1014.2 004800 02 SYS-HRS PIC 99. CM1014.2 004900 02 SYS-MINS PIC 99. CM1014.2 005000 02 SYS-SECS PIC 99V99. CM1014.2 005100 01 MSG-TIME. CM1014.2 005200 02 HOURS PIC 99. CM1014.2 005300 02 MINUTES PIC 99. CM1014.2 005400 02 SECONDS PIC 99V99. CM1014.2 005500 01 SPEC-LINE-1. CM1014.2 005600 02 FILLER PIC X(40) VALUE CM1014.2 005700 " INITIAL ENABLE RETURNED STATUS CODE OF ". CM1014.2 005800 02 INIT-ENABLE-STATUS PIC XX. CM1014.2 005900 01 INCOMING-MSG. CM1014.2 006000 02 KILL-FIELD PIC X(4). CM1014.2 006100 02 FILLER PIC X(68). CM1014.2 006200 01 LOG-HDR-1. CM1014.2 006300 02 FILLER PIC X(48) VALUE SPACES. CM1014.2 006400 02 FILLER PIC X(24) VALUE "LOG OF INCOMING MESSAGES". CM1014.2 006500 01 LOG-HDR-2. CM1014.2 006600 02 FILLER PIC X VALUE SPACE. CM1014.2 006700 02 FILLER PIC X(19) VALUE "SYMBOLIC SOURCE IS ". CM1014.2 006800 02 SYM-SOURCE PIC X(25). CM1014.2 006900 02 FILLER PIC X(16) VALUE "MESSAGE DATE IS ". CM1014.2 007000 02 MSG-DATE PIC 9(6) VALUE ZERO. CM1014.2 007100 01 LOG-HDR-3. CM1014.2 007200 02 FILLER PIC X VALUE SPACE. CM1014.2 007300 02 FILLER PIC X(12) VALUE "TIME RECVD". CM1014.2 007400 02 FILLER PIC X(9) VALUE "LOG LAG". CM1014.2 007500 02 FILLER PIC X(7) VALUE "LENGTH". CM1014.2 007600 02 FILLER PIC X(4) VALUE "END". CM1014.2 007700 02 FILLER PIC X(3) VALUE "QD". CM1014.2 007800 02 FILLER PIC X(40) VALUE "POLL COUNT". CM1014.2 007900 02 FILLER PIC X(16) VALUE "MESSAGE CONTENTS". CM1014.2 008000 01 LOG-HDR-4. CM1014.2 008100 02 FILLER PIC X VALUE SPACE. CM1014.2 008200 02 FILLER PIC X(11) VALUE ALL "-". CM1014.2 008300 02 FILLER PIC X VALUE SPACES. CM1014.2 008400 02 FILLER PIC X(7) VALUE ALL "-". CM1014.2 008500 02 FILLER PIC X(2) VALUE SPACES. CM1014.2 008600 02 FILLER PIC X(6) VALUE ALL "-". CM1014.2 008700 02 FILLER PIC X VALUE SPACE. CM1014.2 008800 02 FILLER PIC XXX VALUE "---". CM1014.2 008900 02 FILLER PIC X VALUE SPACES. CM1014.2 009000 02 FILLER PIC XX VALUE "--". CM1014.2 009100 02 FILLER PIC X VALUE SPACES. CM1014.2 009200 02 FILLER PIC X(10) VALUE ALL "-". CM1014.2 009300 02 FILLER PIC X(2) VALUE SPACES. CM1014.2 009400 02 FILLER PIC X(72) VALUE ALL "-". CM1014.2 009500 01 LOG-LINE. CM1014.2 009600 02 FILLER PIC X VALUE SPACE. CM1014.2 009700 02 RECEIPT-TIME. CM1014.2 009800 03 HOURS PIC 99. CM1014.2 009900 03 FILLER PIC X VALUE ":". CM1014.2 010000 03 MINUTES PIC 99. CM1014.2 010100 03 FILLER PIC X VALUE ":". CM1014.2 010200 03 SECONDS PIC 99.99. CM1014.2 010300 02 LAG-TIME PIC -(4)9.99. CM1014.2 010400 02 FILLER PIC XX VALUE SPACES. CM1014.2 010500 02 MESSAGE-LENGTH PIC ZZZ9. CM1014.2 010600 02 FILLER PIC XXX VALUE SPACES. CM1014.2 010700 02 SENTINEL PIC XXX. CM1014.2 010800 02 FILLER PIC X VALUE SPACES. CM1014.2 010900 02 QUEUE-DEPTH PIC 99. CM1014.2 011000 02 FILLER PIC X VALUE SPACES. CM1014.2 011100 02 IDLE-COUNT PIC ZZ,ZZZ,ZZ9. CM1014.2 011200 02 IDLE-OVERFLOW REDEFINES IDLE-COUNT PIC X(10). CM1014.2 011300 02 FILLER PIC XX VALUE SPACES. CM1014.2 011400 02 MSG PIC X(72). CM1014.2 011500 66 LONG-NARRATIVE RENAMES LAG-TIME THRU MSG. CM1014.2 011600 66 SHORT-NARRATIVE RENAMES IDLE-COUNT THRU MSG. CM1014.2 011700 01 TEST-RESULTS. CM1014.2 011800 02 FILLER PICTURE X VALUE SPACE. CM1014.2 011900 02 FEATURE PICTURE X(18). CM1014.2 012000 02 FILLER PICTURE X VALUE SPACE. CM1014.2 012100 02 P-OR-F PICTURE X(5). CM1014.2 012200 02 FILLER PICTURE X VALUE SPACE. CM1014.2 012300 02 PAR-NAME PIC X(20). CM1014.2 012400 02 FILLER PICTURE X VALUE SPACE. CM1014.2 012500 02 COMPUTED-A. CM1014.2 012600 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 012700 03 COMPUTED-STATUS PIC XX. CM1014.2 012800 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 012900 02 FILLER PICTURE X VALUE SPACE. CM1014.2 013000 02 CORRECT-A. CM1014.2 013100 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 013200 03 CORRECT-STATUS PIC XX. CM1014.2 013300 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 013400 02 FILLER PICTURE X VALUE SPACE. CM1014.2 013500 02 RE-MARK PICTURE X(30). CM1014.2 013600 01 COLUMNS-LINE-1. CM1014.2 013700 02 FILLER PIC X(3) VALUE SPACES. CM1014.2 013800 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM1014.2 013900 02 FILLER PIC X(9) VALUE "RESLT". CM1014.2 014000 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM1014.2 014100 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM1014.2 014200 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM1014.2 014300 02 FILLER PIC X(7) VALUE "REMARKS". CM1014.2 014400 01 COLUMNS-LINE-2. CM1014.2 014500 02 FILLER PIC X VALUE SPACE. CM1014.2 014600 02 FILLER PIC X(18) VALUE ALL "-". CM1014.2 014700 02 FILLER PIC X VALUE SPACE. CM1014.2 014800 02 FILLER PIC X(5) VALUE ALL "-". CM1014.2 014900 02 FILLER PIC X VALUE SPACE. CM1014.2 015000 02 FILLER PIC X(20) VALUE ALL "-". CM1014.2 015100 02 FILLER PIC X VALUE SPACE. CM1014.2 015200 02 FILLER PIC X(20) VALUE ALL "-". CM1014.2 015300 02 FILLER PIC X VALUE SPACE. CM1014.2 015400 02 FILLER PIC X(20) VALUE ALL "-". CM1014.2 015500 02 FILLER PIC X VALUE SPACE. CM1014.2 015600 02 FILLER PIC X(31) VALUE ALL "-". CM1014.2 015700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1014.2 015800 01 REC-CT PICTURE 99 VALUE ZERO. CM1014.2 015900 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1014.2 016000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1014.2 016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1014.2 016200 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1014.2 016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1014.2 016400 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1014.2 016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1014.2 016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1014.2 016700 01 CCVS-H-1. CM1014.2 016800 02 FILLER PICTURE X(27) VALUE SPACE. CM1014.2 016900 02 FILLER PICTURE X(67) VALUE CM1014.2 017000 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1014.2 017100- " SYSTEM". CM1014.2 017200 02 FILLER PICTURE X(26) VALUE SPACE. CM1014.2 017300 01 CCVS-H-2. CM1014.2 017400 02 FILLER PICTURE X(52) VALUE IS CM1014.2 017500 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1014.2 017600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1014.2 017700 02 TEST-ID PICTURE IS X(9). CM1014.2 017800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1014.2 017900 01 CCVS-H-3. CM1014.2 018000 02 FILLER PICTURE X(34) VALUE CM1014.2 018100 " FOR OFFICIAL USE ONLY ". CM1014.2 018200 02 FILLER PICTURE X(58) VALUE CM1014.2 018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1014.2 018400 02 FILLER PICTURE X(28) VALUE CM1014.2 018500 " COPYRIGHT 1974 ". CM1014.2 018600 01 CCVS-E-1. CM1014.2 018700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1014.2 018800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1014.2 018900 02 ID-AGAIN PICTURE IS X(9). CM1014.2 019000 02 FILLER PICTURE X(45) VALUE IS CM1014.2 019100 " NTIS DISTRIBUTION COBOL 74". CM1014.2 019200 01 CCVS-E-2. CM1014.2 019300 02 FILLER PICTURE X(31) VALUE CM1014.2 019400 SPACE. CM1014.2 019500 02 FILLER PICTURE X(21) VALUE SPACE. CM1014.2 019600 02 CCVS-E-2-2. CM1014.2 019700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1014.2 019800 03 FILLER PICTURE IS X VALUE IS SPACE. CM1014.2 019900 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1014.2 020000 01 CCVS-E-3. CM1014.2 020100 02 FILLER PICTURE X(22) VALUE CM1014.2 020200 " FOR OFFICIAL USE ONLY". CM1014.2 020300 02 FILLER PICTURE X(12) VALUE SPACE. CM1014.2 020400 02 FILLER PICTURE X(58) VALUE CM1014.2 020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1014.2 020600 02 FILLER PICTURE X(13) VALUE SPACE. CM1014.2 020700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1014.2 020800 01 CCVS-E-4. CM1014.2 020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1014.2 021000 02 FILLER PIC XXXX VALUE " OF ". CM1014.2 021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1014.2 021200 02 FILLER PIC X(40) VALUE CM1014.2 021300 " TESTS WERE EXECUTED SUCCESSFULLY". CM1014.2 021400 01 XXINFO. CM1014.2 021500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1014.2 021600 02 INFO-TEXT. CM1014.2 021700 04 FILLER PIC X(20) VALUE SPACE. CM1014.2 021800 04 XXCOMPUTED PIC X(20). CM1014.2 021900 04 FILLER PIC X(5) VALUE SPACE. CM1014.2 022000 04 XXCORRECT PIC X(20). CM1014.2 022100 01 HYPHEN-LINE. CM1014.2 022200 02 FILLER PICTURE IS X VALUE IS SPACE. CM1014.2 022300 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1014.2 022400- "*****************************************". CM1014.2 022500 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1014.2 022600- "******************************". CM1014.2 022700 01 CCVS-PGM-ID PIC X(6) VALUE CM1014.2 022800 "CM101M". CM1014.2 022900 COMMUNICATION SECTION. CM1014.2 023000 CD CM-INQUE-1 FOR INPUT CM1014.2 023100 SYMBOLIC QUEUE IS MAIN-QUEUE CM1014.2 023200 SYMBOLIC SUB-QUEUE-1 IS NO-SPEC-1 CM1014.2 023300 SYMBOLIC SUB-QUEUE-2 IS NO-SPEC-2 CM1014.2 023400 SYMBOLIC SUB-QUEUE-3 IS NO-SPEC-3 CM1014.2 023500 MESSAGE DATE IS DATE-RECEIVED CM1014.2 023600 MESSAGE TIME IS TIME-RECEIVED CM1014.2 023700 SYMBOLIC SOURCE IS WHERE-FROM CM1014.2 023800 TEXT LENGTH IS MSG-LENGTH CM1014.2 023900 END KEY IS END-KEY CM1014.2 024000 STATUS KEY IS STATUS-KEY CM1014.2 024100 MESSAGE COUNT IS MSG-COUNT. CM1014.2 024200 PROCEDURE DIVISION. CM1014.2 024300 SECT-CM101M-0001 SECTION. CM1014.2 024400 CM101M-INIT. CM1014.2 024500 OPEN OUTPUT PRINT-FILE. CM1014.2 024600 MOVE "CM101M " TO TEST-ID. CM1014.2 024700 MOVE TEST-ID TO ID-AGAIN. CM1014.2 024800 MOVE SPACE TO TEST-RESULTS. CM1014.2 024900 PERFORM HEAD-ROUTINE. CM1014.2 025000 MOVE CM1014.2 025100 XXXXX030 CM1014.2 025200 TO MAIN-QUEUE. CM1014.2 025300 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 025400 ENABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 025500 XXXXX031. CM1014.2 025600 MOVE STATUS-KEY TO INIT-ENABLE-STATUS. CM1014.2 025700 MOVE SPEC-LINE-1 TO PRINT-REC. CM1014.2 025800 WRITE PRINT-REC CM1014.2 025900 AFTER 2 LINES. CM1014.2 026000 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 026100 WRITE PRINT-REC CM1014.2 026200 AFTER 2 LINES. CM1014.2 026300 LOG-INIT. CM1014.2 026400 MOVE ZERO TO POLL-COUNT. CM1014.2 026500 MOVE ALL "*" TO MSG. CM1014.2 026600 LOG-MSG. CM1014.2 026700 MOVE SPACES TO INCOMING-MSG. CM1014.2 026800 RECEIVE CM-INQUE-1 MESSAGE INTO INCOMING-MSG CM1014.2 026900 NO DATA PERFORM INCREMENT-POLL-COUNT GO TO LOG-MSG. CM1014.2 027000 ACCEPT SYSTEM-TIME FROM TIME. CM1014.2 027100 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM1014.2 027200 IF STATUS-KEY IS NOT EQUAL TO ZERO CM1014.2 027300 DISPLAY "RUN ABORTED - STATUS KEY WAS " STATUS-KEY CM1014.2 027400 STOP RUN. CM1014.2 027500 IF MSG-DATE IS EQUAL TO ZERO PERFORM LOG-HEADER. CM1014.2 027600 IF KILL-FIELD IS EQUAL TO "KILL" CM1014.2 027700 ACCEPT INIT-TIME FROM TIME CM1014.2 027800 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 027900 XXXXX031 CM1014.2 028000 ACCEPT COMP-TIME FROM TIME CM1014.2 028100 MOVE STATUS-KEY TO DISABLE-STATUS. CM1014.2 028200 MOVE TIME-RECEIVED TO MSG-TIME. CM1014.2 028300 MOVE CORR MSG-TIME TO RECEIPT-TIME. CM1014.2 028400 COMPUTE LAG-TIME = CM1014.2 028500 ((SYS-HRS * 3600) + (SYS-MINS * 60) + SYS-SECS) - CM1014.2 028600 ((HOURS OF MSG-TIME * 3600) + (MINUTES OF MSG-TIME * 60) CM1014.2 028700 + SECONDS OF MSG-TIME). CM1014.2 028800 IF END-KEY IS EQUAL TO "3" CM1014.2 028900 MOVE "EGI" TO SENTINEL CM1014.2 029000 ELSE IF END-KEY IS EQUAL TO "2" CM1014.2 029100 MOVE "EMI" TO SENTINEL CM1014.2 029200 ELSE MOVE END-KEY TO SENTINEL. CM1014.2 029300 MOVE MSG-COUNT TO QUEUE-DEPTH. CM1014.2 029400 MOVE MSG-LENGTH TO MESSAGE-LENGTH. CM1014.2 029500 IF POLL-COUNT IS EQUAL TO 99999999 CM1014.2 029600 MOVE " OVERFLOW " TO IDLE-OVERFLOW CM1014.2 029700 ELSE MOVE POLL-COUNT TO IDLE-COUNT. CM1014.2 029800 MOVE INCOMING-MSG TO MSG. CM1014.2 029900 MOVE LOG-LINE TO PRINT-REC. CM1014.2 030000 PERFORM WRITE-LINE. CM1014.2 030100 LOG-MSG-01. CM1014.2 030200 IF KILL-FIELD IS EQUAL TO "WAIT" CM1014.2 030300 PERFORM GET-INITIAL-TIME CM1014.2 030400 PERFORM DELAY-FOR-30-SECS CM1014.2 030500 GO TO LOG-INIT. CM1014.2 030600 IF KILL-FIELD IS NOT EQUAL TO "KILL" GO TO LOG-INIT. CM1014.2 030700 DISABLE-CM-INQUE-1. CM1014.2 030800 MOVE INIT-TIME TO MSG-TIME. CM1014.2 030900 MOVE CORR MSG-TIME TO RECEIPT-TIME. CM1014.2 031000 MOVE "-DISABLE COMMAND INITIATED FROM PROGRAM" CM1014.2 031100 TO LONG-NARRATIVE. CM1014.2 031200 MOVE LOG-LINE TO PRINT-REC. CM1014.2 031300 WRITE PRINT-REC CM1014.2 031400 AFTER 2 LINES. CM1014.2 031500 MOVE COMP-TIME TO MSG-TIME. CM1014.2 031600 MOVE CORR MSG-TIME TO RECEIPT-TIME. CM1014.2 031700 MOVE "- STATUS CODE OF" TO LONG-NARRATIVE. CM1014.2 031800 MOVE DISABLE-STATUS TO QUEUE-DEPTH. CM1014.2 031900 MOVE "AND EXECUTION CONTROL RETURNED FROM MCS" CM1014.2 032000 TO SHORT-NARRATIVE. CM1014.2 032100 MOVE LOG-LINE TO PRINT-REC. CM1014.2 032200 PERFORM WRITE-LINE. CM1014.2 032300 MOVE SPACES TO PRINT-REC. CM1014.2 032400 PERFORM WRITE-LINE. CM1014.2 032500 GET-INITIAL-TIME. CM1014.2 032600 ACCEPT SYSTEM-TIME FROM TIME. CM1014.2 032700 COMPUTE INIT-TIME = CM1014.2 032800 SYS-HRS * 3600 + SYS-MINS * 60 + SYS-SECS. CM1014.2 032900 LOOK-FOR-LATE-TRANSMISSIONS. CM1014.2 033000 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM1014.2 033100 IF MSG-COUNT IS NOT EQUAL TO ZERO CM1014.2 033200 PERFORM LOG-INIT THRU LOG-MSG CM1014.2 033300 GO TO LOOK-FOR-LATE-TRANSMISSIONS. CM1014.2 033400 GET-TIME-DIFFERENCE. CM1014.2 033500 ACCEPT SYSTEM-TIME FROM TIME. CM1014.2 033600 COMPUTE COMP-TIME = CM1014.2 033700 SYS-HRS * 3600 + SYS-MINS * 60 + SYS-SECS - INIT-TIME. CM1014.2 033800 CHECK-FOR-15. CM1014.2 033900 IF COMP-TIME IS LESS THAN 15 CM1014.2 034000 GO TO LOOK-FOR-LATE-TRANSMISSIONS. CM1014.2 034100 15-SECONDS-HAVE-ELAPSED. CM1014.2 034200 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 034300 WRITE PRINT-REC CM1014.2 034400 AFTER 2 LINES. CM1014.2 034500 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 034600 PERFORM WRITE-LINE. CM1014.2 034700 STATUS-TESTS-INIT. CM1014.2 034800 MOVE " BEGIN INPUT STATUS TESTS" TO PRINT-REC. CM1014.2 034900 WRITE PRINT-REC CM1014.2 035000 AFTER 2 LINES. CM1014.2 035100 MOVE COLUMNS-LINE-1 TO PRINT-REC. CM1014.2 035200 WRITE PRINT-REC CM1014.2 035300 AFTER 2 LINES. CM1014.2 035400 MOVE COLUMNS-LINE-2 TO PRINT-REC. CM1014.2 035500 PERFORM WRITE-LINE. CM1014.2 035600 MOVE SPACES TO PRINT-REC. CM1014.2 035700 PERFORM WRITE-LINE. CM1014.2 035800 MOVE "MCS STATUS WORD" TO FEATURE. CM1014.2 035900 REC-STATUS-TEST-01. CM1014.2 036000 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 036100 MOVE "99" TO STATUS-KEY. CM1014.2 036200 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 036300 RECEIVE CM-INQUE-1 MESSAGE INTO INCOMING-MSG CM1014.2 036400 NO DATA ADD 0 TO POLL-COUNT. CM1014.2 036500 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 036600 PERFORM PASS GO TO REC-STATUS-WRITE-01. CM1014.2 036700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 036800 MOVE "20" TO CORRECT-STATUS. CM1014.2 036900 PERFORM FAIL. CM1014.2 037000 GO TO REC-STATUS-WRITE-01. CM1014.2 037100 REC-STATUS-DELETE-01. CM1014.2 037200 PERFORM DE-LETE. CM1014.2 037300 REC-STATUS-WRITE-01. CM1014.2 037400 MOVE "REC-STATUS-TEST-01" TO PAR-NAME. CM1014.2 037500 PERFORM PRINT-DETAIL. CM1014.2 037600 REC-STATUS-TEST-02. CM1014.2 037700 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 037800 MOVE "99" TO STATUS-KEY. CM1014.2 037900 MOVE CM1014.2 038000 XXXXX030 CM1014.2 038100 TO MAIN-QUEUE. CM1014.2 038200 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 038300 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 038400 RECEIVE CM-INQUE-1 MESSAGE INTO INCOMING-MSG CM1014.2 038500 NO DATA ADD 0 TO POLL-COUNT. CM1014.2 038600 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 038700 PERFORM PASS GO TO REC-STATUS-WRITE-02. CM1014.2 038800 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 038900 MOVE "20" TO CORRECT-STATUS. CM1014.2 039000 PERFORM FAIL. CM1014.2 039100 GO TO REC-STATUS-WRITE-02. CM1014.2 039200 REC-STATUS-DELETE-02. CM1014.2 039300 PERFORM DE-LETE. CM1014.2 039400 REC-STATUS-WRITE-02. CM1014.2 039500 MOVE "REC-STATUS-TEST-02" TO PAR-NAME. CM1014.2 039600 PERFORM PRINT-DETAIL. CM1014.2 039700 ACCPT-STATUS-TEST-01. CM1014.2 039800 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 039900 MOVE "99" TO STATUS-KEY. CM1014.2 040000 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 040100 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM1014.2 040200 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 040300 PERFORM PASS GO TO ACCPT-STATUS-WRITE-01. CM1014.2 040400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 040500 MOVE "20" TO CORRECT-STATUS. CM1014.2 040600 PERFORM FAIL. CM1014.2 040700 GO TO ACCPT-STATUS-WRITE-01. CM1014.2 040800 ACCPT-STATUS-DELETE-01. CM1014.2 040900 PERFORM DE-LETE. CM1014.2 041000 ACCPT-STATUS-WRITE-01. CM1014.2 041100 MOVE "ACCPT-STATUS-TEST-01" TO PAR-NAME. CM1014.2 041200 PERFORM PRINT-DETAIL. CM1014.2 041300 ACCPT-STATUS-TEST-02. CM1014.2 041400 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 041500 MOVE "99" TO STATUS-KEY. CM1014.2 041600 MOVE CM1014.2 041700 XXXXX030 CM1014.2 041800 TO MAIN-QUEUE. CM1014.2 041900 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 042000 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 042100 ACCEPT CM-INQUE-1 COUNT. CM1014.2 042200 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 042300 PERFORM PASS GO TO ACCPT-STATUS-WRITE-02. CM1014.2 042400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 042500 MOVE "20" TO CORRECT-STATUS. CM1014.2 042600 PERFORM FAIL. CM1014.2 042700 GO TO ACCPT-STATUS-WRITE-02. CM1014.2 042800 ACCPT-STATUS-DELETE-02. CM1014.2 042900 PERFORM DE-LETE. CM1014.2 043000 ACCPT-STATUS-WRITE-02. CM1014.2 043100 MOVE "ACCPT-STATUS-TEST-02" TO PAR-NAME. CM1014.2 043200 PERFORM PRINT-DETAIL. CM1014.2 043300 ENABL-STATUS-TEST-01. CM1014.2 043400 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 043500 MOVE "99" TO STATUS-KEY. CM1014.2 043600 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 043700 ENABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 043800 XXXXX031 CM1014.2 043900 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 044000 PERFORM PASS GO TO ENABL-STATUS-WRITE-01. CM1014.2 044100 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 044200 MOVE "20" TO CORRECT-STATUS. CM1014.2 044300 PERFORM FAIL. CM1014.2 044400 GO TO ENABL-STATUS-WRITE-01. CM1014.2 044500 ENABL-STATUS-DELETE-01. CM1014.2 044600 PERFORM DE-LETE. CM1014.2 044700 ENABL-STATUS-WRITE-01. CM1014.2 044800 MOVE "ENABL-STATUS-TEST-01" TO PAR-NAME. CM1014.2 044900 PERFORM PRINT-DETAIL. CM1014.2 045000 ENABL-STATUS-TEST-02. CM1014.2 045100 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 045200 MOVE "99" TO STATUS-KEY. CM1014.2 045300 MOVE CM1014.2 045400 XXXXX030 CM1014.2 045500 TO MAIN-QUEUE. CM1014.2 045600 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 045700 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 045800 ENABLE INPUT CM-INQUE-1 KEY CM1014.2 045900 PASSWORD1. CM1014.2 046000 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 046100 PERFORM PASS GO TO ENABL-STATUS-WRITE-02. CM1014.2 046200 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 046300 MOVE "20" TO CORRECT-STATUS. CM1014.2 046400 PERFORM FAIL. CM1014.2 046500 GO TO ENABL-STATUS-WRITE-02. CM1014.2 046600 ENABL-STATUS-DELETE-02. CM1014.2 046700 PERFORM DE-LETE. CM1014.2 046800 ENABL-STATUS-WRITE-02. CM1014.2 046900 MOVE "ENABL-STATUS-TEST-02" TO PAR-NAME. CM1014.2 047000 PERFORM PRINT-DETAIL. CM1014.2 047100 ENABL-STATUS-TEST-03. CM1014.2 047200 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1014.2 047300 MOVE "99" TO STATUS-KEY. CM1014.2 047400 MOVE CM1014.2 047500 XXXXX030 CM1014.2 047600 TO MAIN-QUEUE. CM1014.2 047700 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 047800 ENABLE INPUT CM-INQUE-1 WITH KEY "LETMEIN". CM1014.2 047900 IF STATUS-KEY IS EQUAL TO "40" CM1014.2 048000 PERFORM PASS GO TO ENABL-STATUS-WRITE-03. CM1014.2 048100 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 048200 MOVE "40" TO CORRECT-STATUS. CM1014.2 048300 PERFORM FAIL. CM1014.2 048400 GO TO ENABL-STATUS-WRITE-03. CM1014.2 048500 ENABL-STATUS-DELETE-03. CM1014.2 048600 PERFORM DE-LETE. CM1014.2 048700 ENABL-STATUS-WRITE-03. CM1014.2 048800 MOVE "ENABL-STATUS-TEST-03" TO PAR-NAME. CM1014.2 048900 PERFORM PRINT-DETAIL. CM1014.2 049000 ENABL-STATUS-TEST-04. CM1014.2 049100 MOVE "NO QUEUE NAME / WRONG PASSWORD" TO RE-MARK. CM1014.2 049200 MOVE "99" TO STATUS-KEY. CM1014.2 049300 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 049400 ENABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 049500 "LETMEIN". CM1014.2 049600 MOVE "INFO" TO P-OR-F. CM1014.2 049700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 049800 MOVE " INFO TEST FOR BOTH" TO CORRECT-A. CM1014.2 049900 GO TO ENABL-STATUS-WRITE-04. CM1014.2 050000 ENABL-STATUS-DELETE-04. CM1014.2 050100 PERFORM DE-LETE. CM1014.2 050200 ENABL-STATUS-WRITE-04. CM1014.2 050300 MOVE "ENABL-STATUS-TEST-04" TO PAR-NAME. CM1014.2 050400 PERFORM PRINT-DETAIL. CM1014.2 050500 DISAB-STATUS-TEST-01. CM1014.2 050600 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 050700 MOVE "99" TO STATUS-KEY. CM1014.2 050800 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 050900 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 051000 XXXXX031 CM1014.2 051100 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 051200 PERFORM PASS GO TO DISAB-STATUS-WRITE-01. CM1014.2 051300 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 051400 MOVE "20" TO CORRECT-STATUS. CM1014.2 051500 PERFORM FAIL. CM1014.2 051600 GO TO DISAB-STATUS-WRITE-01. CM1014.2 051700 DISAB-STATUS-DELETE-01. CM1014.2 051800 PERFORM DE-LETE. CM1014.2 051900 DISAB-STATUS-WRITE-01. CM1014.2 052000 MOVE "DISAB-STATUS-TEST-01" TO PAR-NAME. CM1014.2 052100 PERFORM PRINT-DETAIL. CM1014.2 052200 DISAB-STATUS-TEST-02. CM1014.2 052300 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 052400 MOVE "99" TO STATUS-KEY. CM1014.2 052500 MOVE CM1014.2 052600 XXXXX030 CM1014.2 052700 TO MAIN-QUEUE. CM1014.2 052800 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 052900 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 053000 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 053100 PASSWORD1. CM1014.2 053200 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 053300 PERFORM PASS GO TO DISAB-STATUS-WRITE-02. CM1014.2 053400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 053500 MOVE "20" TO CORRECT-STATUS. CM1014.2 053600 PERFORM FAIL. CM1014.2 053700 GO TO DISAB-STATUS-WRITE-02. CM1014.2 053800 DISAB-STATUS-DELETE-02. CM1014.2 053900 PERFORM DE-LETE. CM1014.2 054000 DISAB-STATUS-WRITE-02. CM1014.2 054100 MOVE "DISAB-STATUS-TEST-02" TO PAR-NAME. CM1014.2 054200 PERFORM PRINT-DETAIL. CM1014.2 054300 DISAB-STATUS-TEST-03. CM1014.2 054400 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1014.2 054500 MOVE "99" TO STATUS-KEY. CM1014.2 054600 MOVE CM1014.2 054700 XXXXX030 CM1014.2 054800 TO MAIN-QUEUE. CM1014.2 054900 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 055000 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 055100 "KILLITNOW". CM1014.2 055200 IF STATUS-KEY IS EQUAL TO "40" CM1014.2 055300 PERFORM PASS GO TO DISAB-STATUS-WRITE-03. CM1014.2 055400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 055500 MOVE "40" TO CORRECT-STATUS. CM1014.2 055600 PERFORM FAIL. CM1014.2 055700 GO TO DISAB-STATUS-WRITE-03. CM1014.2 055800 DISAB-STATUS-DELETE-03. CM1014.2 055900 PERFORM DE-LETE. CM1014.2 056000 DISAB-STATUS-WRITE-03. CM1014.2 056100 MOVE "DISAB-STATUS-TEST-03" TO PAR-NAME. CM1014.2 056200 PERFORM PRINT-DETAIL. CM1014.2 056300 RENAB-STATUS-TEST-01. CM1014.2 056400 MOVE "RE-ENABLE PREVIOUSLY DISABLED" TO RE-MARK. CM1014.2 056500 MOVE "99" TO STATUS-KEY. CM1014.2 056600 MOVE CM1014.2 056700 XXXXX030 CM1014.2 056800 TO MAIN-QUEUE. CM1014.2 056900 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 057000 ENABLE INPUT CM-INQUE-1 KEY CM1014.2 057100 PASSWORD1. CM1014.2 057200 IF STATUS-KEY IS EQUAL TO ZERO CM1014.2 057300 PERFORM PASS GO TO RENAB-STATUS-WRITE-01. CM1014.2 057400 MOVE STATUS-KEY TO COMPUTED-STATUS CM1014.2 057500 MOVE ZERO TO CORRECT-STATUS. CM1014.2 057600 PERFORM FAIL. CM1014.2 057700 GO TO RENAB-STATUS-WRITE-01. CM1014.2 057800 RENAB-STATUS-DELETE-01. CM1014.2 057900 PERFORM DE-LETE. CM1014.2 058000 RENAB-STATUS-WRITE-01. CM1014.2 058100 MOVE "RENAB-STATUS-TEST-01" TO PAR-NAME. CM1014.2 058200 PERFORM PRINT-DETAIL. CM1014.2 058300 CLOSE-FILES. CM1014.2 058400 PERFORM END-ROUTINE THRU END-ROUTINE-3. CM1014.2 058500 CLOSE PRINT-FILE. CM1014.2 058600 STOP RUN. CM1014.2 058700 PASS. CM1014.2 058800 MOVE "PASS" TO P-OR-F. CM1014.2 058900 FAIL. CM1014.2 059000 ADD 1 TO ERROR-COUNTER. CM1014.2 059100 MOVE "FAIL*" TO P-OR-F. CM1014.2 059200 DE-LETE. CM1014.2 059300 MOVE SPACE TO P-OR-F. CM1014.2 059400 MOVE " ************ " TO COMPUTED-A. CM1014.2 059500 MOVE " ************ " TO CORRECT-A. CM1014.2 059600 MOVE "****TEST DELETED****" TO RE-MARK. CM1014.2 059700 ADD 1 TO DELETE-CNT. CM1014.2 059800 PRINT-DETAIL. CM1014.2 059900 MOVE TEST-RESULTS TO PRINT-REC. CM1014.2 060000 PERFORM WRITE-LINE. CM1014.2 060100 MOVE SPACE TO P-OR-F. CM1014.2 060200 MOVE SPACE TO COMPUTED-A. CM1014.2 060300 MOVE SPACE TO CORRECT-A. CM1014.2 060400 END-ROUTINE. CM1014.2 060500 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1014.2 060600 PERFORM WRITE-LINE. CM1014.2 060700 PARA-Z. CM1014.2 060800 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1014.2 060900 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1014.2 061000 PERFORM WRITE-LINE. CM1014.2 061100 END-ROUTINE-1. CM1014.2 061200 PERFORM BLANK-LINE-PRINT. CM1014.2 061300 IF ERROR-COUNTER IS EQUAL TO ZERO CM1014.2 061400 GO TO END-ROUTINE-2. CM1014.2 061500 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM1014.2 061600 GO TO END-ROUTINE-3. CM1014.2 061700 END-ROUTINE-2. CM1014.2 061800 MOVE " NO" TO ERROR-TOTAL. CM1014.2 061900 END-ROUTINE-3. CM1014.2 062000 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1014.2 062100 PERFORM WRITE-LINE. CM1014.2 062200 IF DELETE-CNT IS EQUAL TO ZERO CM1014.2 062300 MOVE " NO" TO ERROR-TOTAL ELSE CM1014.2 062400 MOVE DELETE-CNT TO ERROR-TOTAL. CM1014.2 062500 MOVE "TESTS DELETED " TO ENDER-DESC. CM1014.2 062600 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1014.2 062700 PERFORM WRITE-LINE. CM1014.2 062800 END-ROUTINE-4. CM1014.2 062900 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1014.2 063000 PERFORM WRITE-LINE. CM1014.2 063100 BLANK-LINE-PRINT. CM1014.2 063200 MOVE SPACE TO DUMMY-RECORD. CM1014.2 063300 PERFORM WRITE-LINE. CM1014.2 063400 WRITE-LINE. CM1014.2 063500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1014.2 063600 INCREMENT-POLL-COUNT. CM1014.2 063700 ADD 1 TO POLL-COUNT ON SIZE ERROR ADD 0 TO POLL-COUNT. CM1014.2 063800 DELAY-FOR-30-SECS. CM1014.2 063900 PERFORM GET-TIME-DIFFERENCE. CM1014.2 064000 IF COMP-TIME IS LESS THAN 30 CM1014.2 064100 GO TO DELAY-FOR-30-SECS. CM1014.2 064200 LOG-HEADER. CM1014.2 064300 MOVE LOG-HDR-1 TO PRINT-REC CM1014.2 064400 WRITE PRINT-REC CM1014.2 064500 AFTER 3 LINES. CM1014.2 064600 MOVE DATE-RECEIVED TO MSG-DATE. CM1014.2 064700 MOVE WHERE-FROM TO SYM-SOURCE. CM1014.2 064800 MOVE LOG-HDR-2 TO PRINT-REC. CM1014.2 064900 WRITE PRINT-REC CM1014.2 065000 AFTER 3 LINES. CM1014.2 065100 MOVE LOG-HDR-3 TO PRINT-REC. CM1014.2 065200 WRITE PRINT-REC CM1014.2 065300 AFTER 2 LINES. CM1014.2 065400 MOVE LOG-HDR-4 TO PRINT-REC. CM1014.2 065500 PERFORM WRITE-LINE. CM1014.2 065600 MOVE SPACES TO PRINT-REC. CM1014.2 065700 PERFORM WRITE-LINE. CM1014.2 065800 HEAD-ROUTINE. CM1014.2 065900 MOVE CCVS-H-1 TO PRINT-REC CM1014.2 066000 WRITE PRINT-REC CM1014.2 066100 AFTER ADVANCING PAGE. CM1014.2 066200 MOVE CCVS-H-2 TO PRINT-REC. CM1014.2 066300 WRITE PRINT-REC CM1014.2 066400 AFTER 2 LINES. CM1014.2 066500 MOVE CCVS-H-3 TO PRINT-REC. CM1014.2 066600 WRITE PRINT-REC CM1014.2 066700 AFTER 5 LINES. CM1014.2 066800 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 066900 PERFORM WRITE-LINE. CM1014.2 *END-OF,CM101M *HEADER,COBOL,CM102M 000100 IDENTIFICATION DIVISION. CM1024.2 000200 PROGRAM-ID. CM1024.2 000300 CM102M. CM1024.2 000400 AUTHOR. CM1024.2 000500 FEDERAL COMPILER TESTING CENTER. CM1024.2 000600 INSTALLATION. CM1024.2 000700 GENERAL SERVICES ADMINISTRATION CM1024.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1024.2 000900 SOFTWARE DEVELOPMENT OFFICE. CM1024.2 001000 5203 LEESBURG PIKE SUITE 1100 CM1024.2 001100 FALLS CHURCH VIRGINIA 22041. CM1024.2 001200 CM1024.2 001300 PHONE (703) 756-6153 CM1024.2 001400 CM1024.2 001500 " HIGH ". CM1024.2 001600 DATE-WRITTEN. CM1024.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1024.2 001800 CREATION DATE / VALIDATION DATE CM1024.2 001900 "4.2 ". CM1024.2 002000 SECURITY. CM1024.2 002100 NONE. CM1024.2 002200 ENVIRONMENT DIVISION. CM1024.2 002300 CONFIGURATION SECTION. CM1024.2 002400 SOURCE-COMPUTER. CM1024.2 002500 XXXXX082. CM1024.2 002600 OBJECT-COMPUTER. CM1024.2 002700 XXXXX083. CM1024.2 002800 INPUT-OUTPUT SECTION. CM1024.2 002900 FILE-CONTROL. CM1024.2 003000 SELECT PRINT-FILE ASSIGN TO CM1024.2 003100 XXXXX055. CM1024.2 003200 DATA DIVISION. CM1024.2 003300 FILE SECTION. CM1024.2 003400 FD PRINT-FILE CM1024.2 003500 LABEL RECORDS CM1024.2 003600 XXXXX084 CM1024.2 003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1024.2 003800 01 PRINT-REC PICTURE X(120). CM1024.2 003900 01 DUMMY-RECORD PICTURE X(120). CM1024.2 004000 WORKING-STORAGE SECTION. CM1024.2 004100 77 COMP-TWO PIC 9 COMP VALUE 2. CM1024.2 004200 77 TWO PIC 9 VALUE 2. CM1024.2 004300 77 COMP-THREE PIC 9 VALUE 3. CM1024.2 004400 77 THREE PIC 9 VALUE 3. CM1024.2 004500 77 SEND-SWITCH PIC 99 COMP. CM1024.2 004600 77 MSG-NUM PIC 9(4). CM1024.2 004700 77 MSG-70 PIC X(70). CM1024.2 004800 77 PASSWORD1 PIC X(10) VALUE CM1024.2 004900 XXXXX033. CM1024.2 005000 01 ERR-MSG. CM1024.2 005100 02 FILLER PIC X(33) VALUE CM1024.2 005200 "THIS MESSAGE SHOULD NOT APPEAR - ". CM1024.2 005300 02 TEST-IND PIC X(4). CM1024.2 005400 01 LOG-HDR-1. CM1024.2 005500 02 FILLER PIC X(48) VALUE SPACES. CM1024.2 005600 02 FILLER PIC X(24) VALUE "LOG OF OUTGOING MESSAGES". CM1024.2 005700 01 LOG-HDR-2. CM1024.2 005800 02 FILLER PIC X VALUE SPACE. CM1024.2 005900 02 FILLER PIC X(14) VALUE "START TIME". CM1024.2 006000 02 FILLER PIC X(10) VALUE "ELAPSED". CM1024.2 006100 02 FILLER PIC X(13) VALUE "STATUS/ERR". CM1024.2 006200 02 FILLER PIC X(41) VALUE "LENGTH". CM1024.2 006300 02 FILLER PIC X(7) VALUE "MESSAGE". CM1024.2 006400 01 LOG-HDR-3. CM1024.2 006500 02 FILLER PIC X VALUE SPACES. CM1024.2 006600 02 FILLER PIC X(11) VALUE ALL "-". CM1024.2 006700 02 FILLER PIC XXX VALUE SPACES. CM1024.2 006800 02 FILLER PIC X(7) VALUE ALL "-". CM1024.2 006900 02 FILLER PIC XXX VALUE SPACES. CM1024.2 007000 02 FILLER PIC X(10) VALUE ALL "-". CM1024.2 007100 02 FILLER PIC XXX VALUE SPACES. CM1024.2 007200 02 FILLER PIC X(6) VALUE ALL "-". CM1024.2 007300 02 FILLER PIC XXX VALUE SPACES. CM1024.2 007400 02 FILLER PIC X(72) VALUE ALL "-". CM1024.2 007500 01 LOG-LINE. CM1024.2 007600 02 FILLER PIC X VALUE SPACE. CM1024.2 007700 02 START-TIME. CM1024.2 007800 03 HOURS PIC 99. CM1024.2 007900 03 FILLER PIC X VALUE ":". CM1024.2 008000 03 MINUTES PIC 99. CM1024.2 008100 03 FILLER PIC X VALUE ":". CM1024.2 008200 03 SECONDS PIC 99.99. CM1024.2 008300 02 FILLER PIC XX VALUE SPACES. CM1024.2 008400 02 ELAPSED PIC -(4)9.99. CM1024.2 008500 02 FILLER PIC X(7) VALUE SPACES. CM1024.2 008600 02 STAT PIC 99. CM1024.2 008700 02 FILLER PIC X VALUE "/". CM1024.2 008800 02 ERR PIC 9. CM1024.2 008900 02 FILLER PIC X(5) VALUE SPACES. CM1024.2 009000 02 LNTH PIC ZZZ9. CM1024.2 009100 02 FILLER PIC X(5) VALUE SPACES. CM1024.2 009200 02 MSG-OUT PIC X(72). CM1024.2 009300 01 LOG-LINE-1. CM1024.2 009400 02 FILLER PIC X(39) VALUE SPACES. CM1024.2 009500 02 FILLER PIC X(8) VALUE "CONT". CM1024.2 009600 02 MSG-FLD PIC X(72). CM1024.2 009700 01 SUPERIMPOSITION. CM1024.2 009800 02 S-ALL PIC X(4). CM1024.2 009900 02 S-WORDS PIC X(6). CM1024.2 010000 02 S-IN PIC X(3). CM1024.2 010100 02 S-THIS PIC X(5). CM1024.2 010200 02 S-MESSAGE PIC X(8). CM1024.2 010300 02 S-SHOULD PIC X(7). CM1024.2 010400 02 S-COME PIC X(5). CM1024.2 010500 02 S-OUT PIC X(4). CM1024.2 010600 02 S-ON PIC XXX. CM1024.2 010700 02 S-THE PIC X(4). CM1024.2 010800 02 S-SAME PIC X(5). CM1024.2 010900 02 S-LINE PIC X(5). CM1024.2 011000 01 MSG-A. CM1024.2 011100 02 FILLER PIC X VALUE SPACE. CM1024.2 011200 02 MSG-B. CM1024.2 011300 03 FILLER PIC X VALUE SPACE. CM1024.2 011400 03 MSG-C. CM1024.2 011500 04 FILLER PIC X VALUE SPACE. CM1024.2 011600 04 MSG-D. CM1024.2 011700 05 FILLER PIC X VALUE SPACE. CM1024.2 011800 05 MSG-E. CM1024.2 011900 06 FILLER PIC X(19) VALUE CM1024.2 012000 "THIS IS MESSAGE NO.". CM1024.2 012100 06 MSG-NO PIC ZZZZ. CM1024.2 012200 06 FILLER PIC X(35) VALUE CM1024.2 012300 ".--THIS SENTENCE MUST NOT APPEAR.". CM1024.2 012400 01 SYSTEM-TIME. CM1024.2 012500 02 HOURS PIC 99. CM1024.2 012600 02 MINUTES PIC 99. CM1024.2 012700 02 SECONDS PIC 99V99. CM1024.2 012800 01 COMP-TIME. CM1024.2 012900 02 COMP-HRS PIC 99. CM1024.2 013000 02 COMP-MINS PIC 99. CM1024.2 013100 02 COMP-SECS PIC 99V99. CM1024.2 013200 01 MSG-F. CM1024.2 013300 02 FILLER PIC X(19) VALUE "THIS IS MESSAGE NO.". CM1024.2 013400 02 MSG-F-NO PIC ZZZZ. CM1024.2 013500 02 FILLER PIC X(40) VALUE CM1024.2 013600 " AND SHOULD APPEAR AT THE TOP OF A PAGE.". CM1024.2 013700 01 MSG-G. CM1024.2 013800 02 FILLER PIC X(19) VALUE "THIS IS MESSAGE NO.". CM1024.2 013900 02 MSG-G-NO PIC ZZZZ. CM1024.2 014000 02 FILLER PIC X(41) VALUE CM1024.2 014100 " AND SHOULD APPEAR AFTER TWO BLANK LINES.". CM1024.2 014200 01 MSG-H. CM1024.2 014300 02 FILLER PIC X(19) VALUE "THIS IS MESSAGE NO.". CM1024.2 014400 02 MSG-H-NO PIC ZZZZ. CM1024.2 014500 02 FILLER PIC X(41) VALUE CM1024.2 014600 " AND SHOULD APPEAR BEFORE ONE BLANK LINE.". CM1024.2 014700 01 LONG-MSG. CM1024.2 014800 02 LONG-MSG-S1 PIC X(73) VALUE "ON PAGE XIII-21, PARAGRAPH 3CM1024.2 014900- ".5.4(1)C, THE COBOL STANDARD STATES, ""EXCESS ". CM1024.2 015000 02 LONG-MSG-S2 PIC X(67) VALUE "CHARACTERS OF A MESSAGE OR MCM1024.2 015100- "ESSAGE SEGMENT WILL NOT BE TRUNCATED. ". CM1024.2 015200 02 LONG-MSG-S3 PIC X(71) VALUE "CHARACTERS WILL BE PACKED TOCM1024.2 015300- " A SIZE EQUAL TO THAT OF THE PHYSICAL LINE ". CM1024.2 015400 02 LONG-MSG-S4 PIC X(69) VALUE "AND THEN OUTPUTTED TO THE DECM1024.2 015500- "VICE. THE PROCESS CONTINUES ON THE NEXT ". CM1024.2 015600 02 LONG-MSG-S5 PIC X(73) VALUE "LINE WITH THE EXCESS CHARACTCM1024.2 015700- "ERS."" IF THIS ENTIRE PARAGRAPH WAS RECEIVED ". CM1024.2 015800 02 LONG-MSG-S6 PIC X(71) VALUE "BY THE DESIGNATED DEVICE, THCM1024.2 015900- "EN THE FOREGOING RULE IS SUPPORTED BY THIS ". CM1024.2 016000 02 LONG-MSG-S7 PIC X(9) VALUE "COMPILER.". CM1024.2 016100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1024.2 016200 01 REC-CT PICTURE 99 VALUE ZERO. CM1024.2 016300 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1024.2 016400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1024.2 016500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1024.2 016600 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1024.2 016700 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1024.2 016800 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1024.2 016900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1024.2 017000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1024.2 017100 01 CCVS-H-1. CM1024.2 017200 02 FILLER PICTURE X(27) VALUE SPACE. CM1024.2 017300 02 FILLER PICTURE X(67) VALUE CM1024.2 017400 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1024.2 017500- " SYSTEM". CM1024.2 017600 02 FILLER PICTURE X(26) VALUE SPACE. CM1024.2 017700 01 CCVS-H-2. CM1024.2 017800 02 FILLER PICTURE X(52) VALUE IS CM1024.2 017900 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1024.2 018000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1024.2 018100 02 TEST-ID PICTURE IS X(9). CM1024.2 018200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1024.2 018300 01 CCVS-H-3. CM1024.2 018400 02 FILLER PICTURE X(34) VALUE CM1024.2 018500 " FOR OFFICIAL USE ONLY ". CM1024.2 018600 02 FILLER PICTURE X(58) VALUE CM1024.2 018700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1024.2 018800 02 FILLER PICTURE X(28) VALUE CM1024.2 018900 " COPYRIGHT 1974 ". CM1024.2 019000 01 CCVS-E-1. CM1024.2 019100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1024.2 019200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1024.2 019300 02 ID-AGAIN PICTURE IS X(9). CM1024.2 019400 02 FILLER PICTURE X(45) VALUE IS CM1024.2 019500 " NTIS DISTRIBUTION COBOL 74". CM1024.2 019600 01 CCVS-E-2. CM1024.2 019700 02 FILLER PICTURE X(31) VALUE CM1024.2 019800 SPACE. CM1024.2 019900 02 FILLER PICTURE X(21) VALUE SPACE. CM1024.2 020000 02 CCVS-E-2-2. CM1024.2 020100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1024.2 020200 03 FILLER PICTURE IS X VALUE IS SPACE. CM1024.2 020300 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1024.2 020400 01 CCVS-E-3. CM1024.2 020500 02 FILLER PICTURE X(22) VALUE CM1024.2 020600 " FOR OFFICIAL USE ONLY". CM1024.2 020700 02 FILLER PICTURE X(12) VALUE SPACE. CM1024.2 020800 02 FILLER PICTURE X(58) VALUE CM1024.2 020900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1024.2 021000 02 FILLER PICTURE X(13) VALUE SPACE. CM1024.2 021100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1024.2 021200 01 CCVS-E-4. CM1024.2 021300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1024.2 021400 02 FILLER PIC XXXX VALUE " OF ". CM1024.2 021500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1024.2 021600 02 FILLER PIC X(40) VALUE CM1024.2 021700 " TESTS WERE EXECUTED SUCCESSFULLY". CM1024.2 021800 01 XXINFO. CM1024.2 021900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1024.2 022000 02 INFO-TEXT. CM1024.2 022100 04 FILLER PIC X(20) VALUE SPACE. CM1024.2 022200 04 XXCOMPUTED PIC X(20). CM1024.2 022300 04 FILLER PIC X(5) VALUE SPACE. CM1024.2 022400 04 XXCORRECT PIC X(20). CM1024.2 022500 01 HYPHEN-LINE. CM1024.2 022600 02 FILLER PICTURE IS X VALUE IS SPACE. CM1024.2 022700 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1024.2 022800- "*****************************************". CM1024.2 022900 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1024.2 023000- "******************************". CM1024.2 023100 01 CCVS-PGM-ID PIC X(6) VALUE CM1024.2 023200 "CM102M". CM1024.2 023300 01 TEST-RESULTS. CM1024.2 023400 02 FILLER PICTURE X VALUE SPACE. CM1024.2 023500 02 FEATURE PICTURE X(18). CM1024.2 023600 02 FILLER PICTURE X VALUE SPACE. CM1024.2 023700 02 P-OR-F PICTURE X(5). CM1024.2 023800 02 FILLER PICTURE X VALUE SPACE. CM1024.2 023900 02 PAR-NAME PIC X(20). CM1024.2 024000 02 FILLER PICTURE X VALUE SPACE. CM1024.2 024100 02 COMPUTED-A PICTURE X(20). CM1024.2 024200 02 COMPUTED-SLASH-SET REDEFINES COMPUTED-A. CM1024.2 024300 03 FILLER PIC X(8). CM1024.2 024400 03 COMPUTED-STATUS PIC XX. CM1024.2 024500 03 SLASH PIC X. CM1024.2 024600 03 COMPUTED-ERR-KEY PIC X. CM1024.2 024700 03 FILLER PIC X(8). CM1024.2 024800 02 FILLER PICTURE X VALUE SPACE. CM1024.2 024900 02 CORRECT-A PICTURE X(20). CM1024.2 025000 02 CORRECT-SLASH-SET REDEFINES CORRECT-A. CM1024.2 025100 03 FILLER PIC X(8). CM1024.2 025200 03 CORRECT-2SLASH1 PIC 99/9. CM1024.2 025300 03 FILLER PIC X(8). CM1024.2 025400 02 FILLER PICTURE X VALUE SPACE. CM1024.2 025500 02 RE-MARK PICTURE X(30). CM1024.2 025600 01 COLUMNS-LINE-1. CM1024.2 025700 02 FILLER PIC X(3) VALUE SPACES. CM1024.2 025800 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM1024.2 025900 02 FILLER PIC X(9) VALUE "RESLT". CM1024.2 026000 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM1024.2 026100 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM1024.2 026200 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM1024.2 026300 02 FILLER PIC X(7) VALUE "REMARKS". CM1024.2 026400 01 COLUMNS-LINE-2. CM1024.2 026500 02 FILLER PIC X VALUE SPACE. CM1024.2 026600 02 FILLER PIC X(18) VALUE ALL "-". CM1024.2 026700 02 FILLER PIC X VALUE SPACE. CM1024.2 026800 02 FILLER PIC X(5) VALUE ALL "-". CM1024.2 026900 02 FILLER PIC X VALUE SPACE. CM1024.2 027000 02 FILLER PIC X(20) VALUE ALL "-". CM1024.2 027100 02 FILLER PIC X VALUE SPACE. CM1024.2 027200 02 FILLER PIC X(20) VALUE ALL "-". CM1024.2 027300 02 FILLER PIC X VALUE SPACE. CM1024.2 027400 02 FILLER PIC X(20) VALUE ALL "-". CM1024.2 027500 02 FILLER PIC X VALUE SPACE. CM1024.2 027600 02 FILLER PIC X(31) VALUE ALL "-". CM1024.2 027700 COMMUNICATION SECTION. CM1024.2 027800 CD CM-OUTQUE-1 FOR OUTPUT CM1024.2 027900 DESTINATION COUNT IS ONE CM1024.2 028000 TEXT LENGTH IS MSG-LENGTH CM1024.2 028100 STATUS KEY IS STATUS-KEY CM1024.2 028200 ERROR KEY IS ERR-KEY CM1024.2 028300 SYMBOLIC DESTINATION IS SYM-DEST. CM1024.2 028400 PROCEDURE DIVISION. CM1024.2 028500 SECT-CM102M-0001 SECTION. CM1024.2 028600 CM102M-INIT. CM1024.2 028700 OPEN OUTPUT PRINT-FILE. CM1024.2 028800 MOVE "CM102M " TO TEST-ID. CM1024.2 028900 MOVE TEST-ID TO ID-AGAIN. CM1024.2 029000 MOVE SPACE TO TEST-RESULTS. CM1024.2 029100 PERFORM HEAD-ROUTINE. CM1024.2 029200 PERFORM COLUMN-NAMES-ROUTINE. CM1024.2 029300 MOVE "MCS STATUS WORD" TO FEATURE. CM1024.2 029400 DISAB-STATUS-TEST-01. CM1024.2 029500 MOVE "INITIAL DISABLE TO OUTPUT CD" TO RE-MARK. CM1024.2 029600 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 029700 MOVE 1 TO ONE. CM1024.2 029800 MOVE CM1024.2 029900 XXXXX032 CM1024.2 030000 TO SYM-DEST. CM1024.2 030100 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 030200 XXXXX033. CM1024.2 030300 MOVE "INFO" TO P-OR-F. CM1024.2 030400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 030500 MOVE "/" TO SLASH. CM1024.2 030600 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 030700 MOVE " INFO TEST FOR" TO CORRECT-A. CM1024.2 030800 GO TO DISAB-STATUS-WRITE-01. CM1024.2 030900 DISAB-STATUS-DELETE-01. CM1024.2 031000 PERFORM DE-LETE. CM1024.2 031100 DISAB-STATUS-WRITE-01. CM1024.2 031200 MOVE "DISAB-STATUS-TEST-01" TO PAR-NAME. CM1024.2 031300 PERFORM PRINT-DETAIL. CM1024.2 031400 DISAB-STATUS-TEST-02. CM1024.2 031500 MOVE "NO DESTINATION SPECIFIED" TO RE-MARK. CM1024.2 031600 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 031700 MOVE "GARBAGE" TO SYM-DEST. CM1024.2 031800 MOVE 1 TO ONE. CM1024.2 031900 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 032000 XXXXX033. CM1024.2 032100 IF STATUS-KEY IS EQUAL TO "20" CM1024.2 032200 AND ERR-KEY IS EQUAL TO "1" CM1024.2 032300 PERFORM PASS GO TO DISAB-STATUS-WRITE-02. CM1024.2 032400 MOVE 201 TO CORRECT-2SLASH1. CM1024.2 032500 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 032600 MOVE "/" TO SLASH. CM1024.2 032700 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 032800 PERFORM FAIL. CM1024.2 032900 GO TO DISAB-STATUS-WRITE-02. CM1024.2 033000 DISAB-STATUS-DELETE-02. CM1024.2 033100 PERFORM DE-LETE. CM1024.2 033200 DISAB-STATUS-WRITE-02. CM1024.2 033300 MOVE "DISAB-STATUS-TEST-02" TO PAR-NAME. CM1024.2 033400 PERFORM PRINT-DETAIL. CM1024.2 033500 DISAB-STATUS-TEST-03. CM1024.2 033600 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1024.2 033700 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 033800 MOVE 1 TO ONE. CM1024.2 033900 MOVE CM1024.2 034000 XXXXX032 CM1024.2 034100 TO SYM-DEST. CM1024.2 034200 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 034300 "GARBAGE". CM1024.2 034400 IF STATUS-KEY IS EQUAL TO "40" CM1024.2 034500 PERFORM PASS GO TO DISAB-STATUS-WRITE-03. CM1024.2 034600 MOVE 400 TO CORRECT-2SLASH1. CM1024.2 034700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 034800 MOVE "/" TO SLASH. CM1024.2 034900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 035000 PERFORM FAIL. CM1024.2 035100 GO TO DISAB-STATUS-WRITE-03. CM1024.2 035200 DISAB-STATUS-DELETE-03. CM1024.2 035300 PERFORM DE-LETE. CM1024.2 035400 DISAB-STATUS-WRITE-03. CM1024.2 035500 MOVE "DISAB-STATUS-TEST-03" TO PAR-NAME. CM1024.2 035600 PERFORM PRINT-DETAIL. CM1024.2 035700 DISAB-STATUS-TEST-04. CM1024.2 035800 MOVE "INVALID DESTINATION COUNT (0)" TO RE-MARK. CM1024.2 035900 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 036000 MOVE CM1024.2 036100 XXXXX032 CM1024.2 036200 TO SYM-DEST. CM1024.2 036300 MOVE 0 TO ONE. CM1024.2 036400 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 036500 XXXXX033. CM1024.2 036600 IF STATUS-KEY IS EQUAL TO "30" CM1024.2 036700 PERFORM PASS GO TO DISAB-STATUS-WRITE-04. CM1024.2 036800 MOVE 300 TO CORRECT-2SLASH1. CM1024.2 036900 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 037000 MOVE "/" TO SLASH. CM1024.2 037100 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 037200 PERFORM FAIL. CM1024.2 037300 GO TO DISAB-STATUS-WRITE-04. CM1024.2 037400 DISAB-STATUS-DELETE-04. CM1024.2 037500 PERFORM DE-LETE. CM1024.2 037600 DISAB-STATUS-WRITE-04. CM1024.2 037700 MOVE "DISAB-STATUS-TEST-04" TO PAR-NAME. CM1024.2 037800 PERFORM PRINT-DETAIL. CM1024.2 037900 DISAB-STATUS-TEST-05. CM1024.2 038000 MOVE "COMBINATION ERROR" TO RE-MARK. CM1024.2 038100 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 038200 MOVE SPACES TO SYM-DEST. CM1024.2 038300 MOVE 0 TO ONE. CM1024.2 038400 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 038500 "GARBAGE". CM1024.2 038600 MOVE "INFO" TO P-OR-F. CM1024.2 038700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 038800 MOVE "/" TO SLASH. CM1024.2 038900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 039000 GO TO DISAB-STATUS-WRITE-05. CM1024.2 039100 DISAB-STATUS-DELETE-05. CM1024.2 039200 PERFORM DE-LETE. CM1024.2 039300 DISAB-STATUS-WRITE-05. CM1024.2 039400 MOVE "DISAB-STATUS-TEST-05" TO PAR-NAME. CM1024.2 039500 PERFORM PRINT-DETAIL. CM1024.2 039600 SEND-STATUS-TEST-01. CM1024.2 039700 MOVE "DESTINATION DISABLED" TO RE-MARK. CM1024.2 039800 MOVE "CM102M- I AM THE FIRST MESSAGE IN QUEUE;" TO MSG-70. CM1024.2 039900 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 040000 MOVE CM1024.2 040100 XXXXX032 CM1024.2 040200 TO SYM-DEST. CM1024.2 040300 MOVE 1 TO ONE. CM1024.2 040400 MOVE 45 TO MSG-LENGTH. CM1024.2 040500 SEND CM-OUTQUE-1 FROM MSG-70 WITH EMI CM1024.2 040600 AFTER ADVANCING PAGE. CM1024.2 040700 MOVE "THOU SHALT HAVE NO OTHER MESSAGES BEFORE ME." TO MSG-70CM1024.2 040800 SEND CM-OUTQUE-1 FROM MSG-70 WITH EMI. CM1024.2 040900 MOVE SPACES TO MSG-70. CM1024.2 041000 MOVE 1 TO MSG-LENGTH. CM1024.2 041100 SEND CM-OUTQUE-1 FROM MSG-70 WITH EGI. CM1024.2 041200 IF STATUS-KEY IS EQUAL TO "10" CM1024.2 041300 PERFORM PASS GO TO SEND-STATUS-WRITE-01. CM1024.2 041400 MOVE 100 TO CORRECT-2SLASH1. CM1024.2 041500 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 041600 MOVE "/" TO SLASH. CM1024.2 041700 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 041800 PERFORM FAIL. CM1024.2 041900 GO TO SEND-STATUS-WRITE-01. CM1024.2 042000 SEND-STATUS-DELETE-01. CM1024.2 042100 PERFORM DE-LETE. CM1024.2 042200 SEND-STATUS-WRITE-01. CM1024.2 042300 MOVE "SEND-STATUS-TEST-01" TO PAR-NAME. CM1024.2 042400 PERFORM PRINT-DETAIL. CM1024.2 042500 SEND-STATUS-TEST-02. CM1024.2 042600 MOVE "COMBINATION ERROR" TO RE-MARK. CM1024.2 042700 MOVE SPACES TO SYM-DEST. CM1024.2 042800 MOVE 0 TO ONE. CM1024.2 042900 MOVE 100 TO MSG-LENGTH. CM1024.2 043000 MOVE "S-02" TO TEST-IND. CM1024.2 043100 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 043200 MOVE "INFO" TO P-OR-F. CM1024.2 043300 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 043400 MOVE "/" TO SLASH. CM1024.2 043500 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 043600 GO TO SEND-STATUS-WRITE-02. CM1024.2 043700 SEND-STATUS-DELETE-02. CM1024.2 043800 PERFORM DE-LETE. CM1024.2 043900 SEND-STATUS-WRITE-02. CM1024.2 044000 MOVE "SEND-STATUS-TEST-02" TO PAR-NAME. CM1024.2 044100 PERFORM PRINT-DETAIL. CM1024.2 044200 ENABL-STATUS-TEST-01. CM1024.2 044300 MOVE "DESTINATION NOT SPECIFIED" TO RE-MARK. CM1024.2 044400 MOVE SPACES TO SYM-DEST. CM1024.2 044500 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 044600 MOVE 1 TO ONE. CM1024.2 044700 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 044800 XXXXX033. CM1024.2 044900 IF STATUS-KEY IS EQUAL TO "20" CM1024.2 045000 AND ERR-KEY IS EQUAL TO "1" CM1024.2 045100 PERFORM PASS GO TO ENABL-STATUS-WRITE-01. CM1024.2 045200 MOVE 201 TO CORRECT-2SLASH1. CM1024.2 045300 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 045400 MOVE "/" TO SLASH. CM1024.2 045500 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 045600 PERFORM FAIL. CM1024.2 045700 GO TO ENABL-STATUS-WRITE-01. CM1024.2 045800 ENABL-STATUS-DELETE-01. CM1024.2 045900 PERFORM DE-LETE. CM1024.2 046000 ENABL-STATUS-WRITE-01. CM1024.2 046100 MOVE "ENABL-STATUS-TEST-01" TO PAR-NAME. CM1024.2 046200 PERFORM PRINT-DETAIL. CM1024.2 046300 ENABL-STATUS-TEST-02. CM1024.2 046400 MOVE "INVALID DESTINATION COUNT (0)" TO RE-MARK. CM1024.2 046500 MOVE CM1024.2 046600 XXXXX032 CM1024.2 046700 TO SYM-DEST. CM1024.2 046800 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 046900 MOVE 0 TO ONE. CM1024.2 047000 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 047100 XXXXX033. CM1024.2 047200 IF STATUS-KEY IS EQUAL TO "30" CM1024.2 047300 PERFORM PASS GO TO ENABL-STATUS-WRITE-02. CM1024.2 047400 MOVE 300 TO CORRECT-2SLASH1. CM1024.2 047500 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 047600 MOVE "/" TO SLASH. CM1024.2 047700 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 047800 PERFORM FAIL. CM1024.2 047900 GO TO ENABL-STATUS-WRITE-02. CM1024.2 048000 ENABL-STATUS-DELETE-02. CM1024.2 048100 PERFORM DE-LETE. CM1024.2 048200 ENABL-STATUS-WRITE-02. CM1024.2 048300 MOVE "ENABL-STATUS-TEST-02" TO PAR-NAME. CM1024.2 048400 PERFORM PRINT-DETAIL. CM1024.2 048500 ENABL-STATUS-TEST-03. CM1024.2 048600 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1024.2 048700 MOVE CM1024.2 048800 XXXXX032 CM1024.2 048900 TO SYM-DEST. CM1024.2 049000 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 049100 MOVE 1 TO ONE. CM1024.2 049200 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 049300 "GARBAGE". CM1024.2 049400 IF STATUS-KEY IS EQUAL TO "40" CM1024.2 049500 PERFORM PASS GO TO ENABL-STATUS-WRITE-03. CM1024.2 049600 MOVE 400 TO CORRECT-2SLASH1. CM1024.2 049700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 049800 MOVE "/" TO SLASH. CM1024.2 049900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 050000 PERFORM FAIL. CM1024.2 050100 GO TO ENABL-STATUS-WRITE-03. CM1024.2 050200 ENABL-STATUS-DELETE-03. CM1024.2 050300 PERFORM DE-LETE. CM1024.2 050400 ENABL-STATUS-WRITE-03. CM1024.2 050500 MOVE "ENABL-STATUS-TEST-03" TO PAR-NAME. CM1024.2 050600 PERFORM PRINT-DETAIL. CM1024.2 050700 ENABL-STATUS-TEST-04. CM1024.2 050800 MOVE "VALID ENABLE/NO ERROR EXPECTED" TO RE-MARK. CM1024.2 050900 MOVE CM1024.2 051000 XXXXX032 CM1024.2 051100 TO SYM-DEST. CM1024.2 051200 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 051300 MOVE 1 TO ONE. CM1024.2 051400 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 051500 XXXXX033. CM1024.2 051600 IF STATUS-KEY IS EQUAL TO ZERO CM1024.2 051700 PERFORM PASS GO TO ENABL-STATUS-WRITE-04. CM1024.2 051800 MOVE 0 TO CORRECT-2SLASH1. CM1024.2 051900 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 052000 MOVE "/" TO SLASH. CM1024.2 052100 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 052200 PERFORM FAIL. CM1024.2 052300 GO TO ENABL-STATUS-WRITE-04. CM1024.2 052400 ENABL-STATUS-DELETE-04. CM1024.2 052500 PERFORM DE-LETE. CM1024.2 052600 ENABL-STATUS-WRITE-04. CM1024.2 052700 MOVE "ENABL-STATUS-TEST-04" TO PAR-NAME. CM1024.2 052800 PERFORM PRINT-DETAIL. CM1024.2 052900 SEND-STATUS-TEST-03. CM1024.2 053000 MOVE "DESTINATION UNKNOWN" TO RE-MARK. CM1024.2 053100 MOVE "GARBAGE" TO SYM-DEST. CM1024.2 053200 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 053300 MOVE 1 TO ONE. CM1024.2 053400 MOVE 37 TO MSG-LENGTH. CM1024.2 053500 MOVE "S-03" TO TEST-IND. CM1024.2 053600 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 053700 IF STATUS-KEY IS EQUAL TO "20" CM1024.2 053800 AND ERR-KEY IS EQUAL TO "1" CM1024.2 053900 PERFORM PASS GO TO SEND-STATUS-WRITE-03. CM1024.2 054000 MOVE 201 TO CORRECT-2SLASH1. CM1024.2 054100 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 054200 MOVE "/" TO SLASH. CM1024.2 054300 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 054400 PERFORM FAIL. CM1024.2 054500 GO TO SEND-STATUS-WRITE-03. CM1024.2 054600 SEND-STATUS-DELETE-03. CM1024.2 054700 PERFORM DE-LETE. CM1024.2 054800 SEND-STATUS-WRITE-03. CM1024.2 054900 MOVE "SEND-STATUS-TEST-03" TO PAR-NAME. CM1024.2 055000 PERFORM PRINT-DETAIL. CM1024.2 055100 SEND-STATUS-TEST-04. CM1024.2 055200 MOVE "DESTINATION COUNT INVALID (0)" TO RE-MARK. CM1024.2 055300 MOVE CM1024.2 055400 XXXXX032 CM1024.2 055500 TO SYM-DEST. CM1024.2 055600 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 055700 MOVE 0 TO ONE. CM1024.2 055800 MOVE 37 TO MSG-LENGTH. CM1024.2 055900 MOVE "S-04" TO TEST-IND. CM1024.2 056000 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 056100 IF STATUS-KEY IS EQUAL TO "30" CM1024.2 056200 PERFORM PASS GO TO SEND-STATUS-WRITE-04. CM1024.2 056300 MOVE 300 TO CORRECT-2SLASH1. CM1024.2 056400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 056500 MOVE "/" TO SLASH. CM1024.2 056600 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 056700 PERFORM FAIL. CM1024.2 056800 GO TO SEND-STATUS-WRITE-04. CM1024.2 056900 SEND-STATUS-DELETE-04. CM1024.2 057000 PERFORM DE-LETE. CM1024.2 057100 SEND-STATUS-WRITE-04. CM1024.2 057200 MOVE "SEND-STATUS-TEST-04" TO PAR-NAME. CM1024.2 057300 PERFORM PRINT-DETAIL. CM1024.2 057400 SEND-STATUS-TEST-05. CM1024.2 057500 MOVE "CHARACTER COUNT EXCESSIVE" TO RE-MARK. CM1024.2 057600 MOVE CM1024.2 057700 XXXXX032 CM1024.2 057800 TO SYM-DEST. CM1024.2 057900 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 058000 MOVE 1 TO ONE. CM1024.2 058100 MOVE 38 TO MSG-LENGTH. CM1024.2 058200 MOVE "S-05" TO TEST-IND. CM1024.2 058300 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 058400 IF STATUS-KEY IS EQUAL TO "50" CM1024.2 058500 PERFORM PASS GO TO SEND-STATUS-WRITE-05. CM1024.2 058600 MOVE 500 TO CORRECT-2SLASH1. CM1024.2 058700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 058800 MOVE "/" TO SLASH. CM1024.2 058900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 059000 PERFORM FAIL. CM1024.2 059100 GO TO SEND-STATUS-WRITE-05. CM1024.2 059200 SEND-STATUS-DELETE-05. CM1024.2 059300 PERFORM DE-LETE. CM1024.2 059400 SEND-STATUS-WRITE-05. CM1024.2 059500 MOVE "SEND-STATUS-TEST-05" TO PAR-NAME. CM1024.2 059600 PERFORM PRINT-DETAIL. CM1024.2 059700 STATUS-TESTS-COMPLETED. CM1024.2 059800 PERFORM END-ROUTINE. CM1024.2 059900 PERFORM END-ROUTINE-1 THRU END-ROUTINE-3. CM1024.2 060000 PERFORM END-ROUTINE. CM1024.2 060100 MOVE LOG-HDR-1 TO PRINT-REC. CM1024.2 060200 WRITE PRINT-REC CM1024.2 060300 AFTER 3 LINES. CM1024.2 060400 MOVE LOG-HDR-2 TO PRINT-REC. CM1024.2 060500 WRITE PRINT-REC CM1024.2 060600 AFTER 3 LINES. CM1024.2 060700 MOVE LOG-HDR-3 TO PRINT-REC. CM1024.2 060800 WRITE PRINT-REC. CM1024.2 060900 PERFORM BLANK-LINE-PRINT. CM1024.2 061000 VARIABLE-LENGTH-MSGS. CM1024.2 061100 MOVE 1 TO ONE. CM1024.2 061200 MOVE CM1024.2 061300 XXXXX032 CM1024.2 061400 TO SYM-DEST. CM1024.2 061500 MOVE 1 TO MSG-NO SEND-SWITCH. CM1024.2 061600 MOVE 28 TO MSG-LENGTH. CM1024.2 061700 MOVE MSG-A TO MSG-OUT. CM1024.2 061800 PERFORM SEND-AND-LOG. CM1024.2 061900 MOVE 2 TO MSG-NO. CM1024.2 062000 MOVE 27 TO MSG-LENGTH. CM1024.2 062100 MOVE MSG-B TO MSG-OUT. CM1024.2 062200 PERFORM SEND-AND-LOG. CM1024.2 062300 MOVE 3 TO MSG-NO. CM1024.2 062400 MOVE 26 TO MSG-LENGTH. CM1024.2 062500 MOVE MSG-C TO MSG-OUT. CM1024.2 062600 PERFORM SEND-AND-LOG. CM1024.2 062700 MOVE 4 TO MSG-NO. CM1024.2 062800 MOVE 25 TO MSG-LENGTH. CM1024.2 062900 MOVE MSG-D TO MSG-OUT. CM1024.2 063000 PERFORM SEND-AND-LOG. CM1024.2 063100 MOVE 2 TO SEND-SWITCH. CM1024.2 063200 MOVE 5 TO MSG-NO. CM1024.2 063300 MOVE 24 TO MSG-LENGTH. CM1024.2 063400 MOVE MSG-E TO MSG-OUT. CM1024.2 063500 PERFORM SEND-AND-LOG. CM1024.2 063600 AFTER-PAGE-MSGS. CM1024.2 063700 MOVE 6 TO MSG-NUM. CM1024.2 063800 MOVE 3 TO SEND-SWITCH. CM1024.2 063900 MOVE 63 TO MSG-LENGTH. CM1024.2 064000 PERFORM AFTER-PAGE-MSGS-01 5 TIMES. CM1024.2 064100 GO TO AFTER-THREE-MSGS. CM1024.2 064200 AFTER-PAGE-MSGS-01. CM1024.2 064300 MOVE MSG-NUM TO MSG-F-NO. CM1024.2 064400 ADD 1 TO MSG-NUM. CM1024.2 064500 MOVE MSG-F TO MSG-OUT. CM1024.2 064600 PERFORM SEND-AND-LOG. CM1024.2 064700 AFTER-THREE-MSGS. CM1024.2 064800 MOVE 64 TO MSG-LENGTH. CM1024.2 064900 PERFORM AFTER-THREE-MSGS-01 5 TIMES. CM1024.2 065000 GO TO EGI-ONLY. CM1024.2 065100 AFTER-THREE-MSGS-01. CM1024.2 065200 MOVE MSG-NUM TO MSG-G-NO. CM1024.2 065300 ADD 1 TO MSG-NUM SEND-SWITCH. CM1024.2 065400 MOVE MSG-G TO MSG-OUT. CM1024.2 065500 PERFORM SEND-AND-LOG. CM1024.2 065600 EGI-ONLY. CM1024.2 065700 MOVE "ONLY EGI WAS SENT. NO MESSAGE ACCOMPANYING" TO MSG-OUTCM1024.2 065800 ADD 1 TO SEND-SWITCH. CM1024.2 065900 MOVE 0 TO MSG-LENGTH. CM1024.2 066000 PERFORM SEND-AND-LOG. CM1024.2 066100 BEFORE-ADV-INIT. CM1024.2 066200 MOVE "0LTH" TO TEST-IND. CM1024.2 066300 ADD 1 TO SEND-SWITCH. CM1024.2 066400 MOVE ERR-MSG TO MSG-OUT. CM1024.2 066500 PERFORM SEND-AND-LOG. CM1024.2 066600 BEFORE-PAGE-MSGS. CM1024.2 066700 MOVE 63 TO MSG-LENGTH. CM1024.2 066800 PERFORM AFTER-PAGE-MSGS-01 5 TIMES. CM1024.2 066900 BEFORE-TWO-MSGS. CM1024.2 067000 MOVE 64 TO MSG-LENGTH. CM1024.2 067100 PERFORM BEFORE-TWO-MSGS-01 5 TIMES. CM1024.2 067200 GO TO ZERO-LINES-MSGS. CM1024.2 067300 BEFORE-TWO-MSGS-01. CM1024.2 067400 MOVE MSG-NUM TO MSG-H-NO. CM1024.2 067500 ADD 1 TO MSG-NUM. CM1024.2 067600 ADD 1 TO SEND-SWITCH. CM1024.2 067700 MOVE MSG-H TO MSG-OUT. CM1024.2 067800 PERFORM SEND-AND-LOG. CM1024.2 067900 ZERO-LINES-MSGS. CM1024.2 068000 ADD 1 TO SEND-SWITCH. CM1024.2 068100 MOVE 59 TO MSG-LENGTH. CM1024.2 068200 MOVE "ALL" TO SUPERIMPOSITION. CM1024.2 068300 PERFORM ZERO-LINES-MSGS-01. CM1024.2 068400 MOVE "WORDS" TO S-WORDS. CM1024.2 068500 PERFORM ZERO-LINES-MSGS-01. CM1024.2 068600 MOVE "IN" TO S-IN. CM1024.2 068700 PERFORM ZERO-LINES-MSGS-01. CM1024.2 068800 MOVE "THIS" TO S-THIS. CM1024.2 068900 PERFORM ZERO-LINES-MSGS-01. CM1024.2 069000 MOVE "MESSAGE" TO S-MESSAGE. CM1024.2 069100 PERFORM ZERO-LINES-MSGS-01. CM1024.2 069200 MOVE "SHOULD" TO S-SHOULD. CM1024.2 069300 PERFORM ZERO-LINES-MSGS-01. CM1024.2 069400 ADD 1 TO SEND-SWITCH. CM1024.2 069500 MOVE "COME" TO S-COME. CM1024.2 069600 PERFORM ZERO-LINES-MSGS-01. CM1024.2 069700 MOVE "OUT" TO S-OUT. CM1024.2 069800 PERFORM ZERO-LINES-MSGS-01. CM1024.2 069900 MOVE "ON" TO S-ON. CM1024.2 070000 PERFORM ZERO-LINES-MSGS-01. CM1024.2 070100 MOVE "THE" TO S-THE. CM1024.2 070200 PERFORM ZERO-LINES-MSGS-01. CM1024.2 070300 MOVE "SAME" TO S-SAME. CM1024.2 070400 PERFORM ZERO-LINES-MSGS-01. CM1024.2 070500 MOVE "LINE." TO S-LINE. CM1024.2 070600 PERFORM ZERO-LINES-MSGS-01. CM1024.2 070700 GO TO 433-CHARACTER-MSG. CM1024.2 070800 ZERO-LINES-MSGS-01. CM1024.2 070900 MOVE SUPERIMPOSITION TO MSG-OUT. CM1024.2 071000 PERFORM SEND-AND-LOG. CM1024.2 071100 MOVE SPACES TO SUPERIMPOSITION. CM1024.2 071200 433-CHARACTER-MSG. CM1024.2 071300 ADD 1 TO SEND-SWITCH. CM1024.2 071400 MOVE 433 TO MSG-LENGTH. CM1024.2 071500 MOVE LONG-MSG-S1 TO MSG-OUT. CM1024.2 071600 PERFORM SEND-AND-LOG. CM1024.2 071700 MOVE LONG-MSG-S2 TO MSG-FLD. CM1024.2 071800 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 071900 MOVE LONG-MSG-S3 TO MSG-FLD. CM1024.2 072000 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 072100 MOVE LONG-MSG-S4 TO MSG-FLD. CM1024.2 072200 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 072300 MOVE LONG-MSG-S5 TO MSG-FLD. CM1024.2 072400 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 072500 MOVE LONG-MSG-S6 TO MSG-FLD. CM1024.2 072600 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 072700 MOVE LONG-MSG-S7 TO MSG-FLD. CM1024.2 072800 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 072900 MSG-BEFORE-DELAY-AND-DISABLE. CM1024.2 073000 MOVE "EXPECT A PAUSE OF UP TO 30 SECONDS BEFORE TRANSMISSION CM1024.2 073100- "OF NEXT MESSAGE." TO MSG-OUT. CM1024.2 073200 MOVE 72 TO MSG-LENGTH. CM1024.2 073300 MOVE 4 TO SEND-SWITCH. CM1024.2 073400 PERFORM SEND-AND-LOG. CM1024.2 073500 DELAY-FOR-30-SECS. CM1024.2 073600 ACCEPT SYSTEM-TIME FROM TIME. CM1024.2 073700 IF (HOURS OF SYSTEM-TIME * 3600 + MINUTES OF SYSTEM-TIME * 60CM1024.2 073800 + SECONDS OF SYSTEM-TIME) - (COMP-HRS * 3600 + COMP-MINS CM1024.2 073900 * 60 + COMP-SECS) IS LESS THAN 30 CM1024.2 074000 GO TO DELAY-FOR-30-SECS. CM1024.2 074100 DISABLE-DEVICE. CM1024.2 074200 MOVE "**** DEVICE DISABLED ****" TO MSG-OUT. CM1024.2 074300 MOVE 0 TO MSG-LENGTH. CM1024.2 074400 MOVE 19 TO SEND-SWITCH. CM1024.2 074500 PERFORM SEND-AND-LOG. CM1024.2 074600 10-WHILE-DISABLED. CM1024.2 074700 MOVE "TRANSMISSION NOW RESUMED." TO MSG-OUT. CM1024.2 074800 MOVE 25 TO MSG-LENGTH. CM1024.2 074900 MOVE 1 TO SEND-SWITCH. CM1024.2 075000 PERFORM SEND-AND-LOG. CM1024.2 075100 MOVE 24 TO MSG-LENGTH. CM1024.2 075200 PERFORM 10-WHILE-DISABLED-01 8 TIMES. CM1024.2 075300 GO TO 10-WHILE-DISABLED-02. CM1024.2 075400 10-WHILE-DISABLED-01. CM1024.2 075500 MOVE MSG-NUM TO MSG-NO. CM1024.2 075600 ADD 1 TO MSG-NUM. CM1024.2 075700 MOVE MSG-E TO MSG-OUT. CM1024.2 075800 PERFORM SEND-AND-LOG. CM1024.2 075900 10-WHILE-DISABLED-02. CM1024.2 076000 MOVE "THERE SHOULD BE NO ABNORMAL DELAY IN RECEIVING THE NEXTCM1024.2 076100- " MESSAGE." TO MSG-OUT. CM1024.2 076200 MOVE 63 TO MSG-LENGTH. CM1024.2 076300 PERFORM SEND-AND-LOG. CM1024.2 076400 RE-ENABLE-OUTQUE. CM1024.2 076500 MOVE "**** DEVICE NOW RE-ENABLED ****" TO MSG-OUT. CM1024.2 076600 MOVE 0 TO MSG-LENGTH. CM1024.2 076700 MOVE 20 TO SEND-SWITCH. CM1024.2 076800 PERFORM SEND-AND-LOG. CM1024.2 076900 ENQUEUE-500-MORE. CM1024.2 077000 MOVE "THIS IS THAT NEXT MESSAGE." TO MSG-OUT. CM1024.2 077100 MOVE 26 TO MSG-LENGTH. CM1024.2 077200 MOVE 2 TO SEND-SWITCH. CM1024.2 077300 PERFORM SEND-AND-LOG. CM1024.2 077400 MOVE 24 TO MSG-LENGTH. CM1024.2 077500 PERFORM 10-WHILE-DISABLED-01 500 TIMES. CM1024.2 077600 DELAY-DISABLE-DELAY-AND-STOP. CM1024.2 077700 PERFORM DELAY-FOR-30-SECS. CM1024.2 077800 PERFORM DISABLE-DEVICE. CM1024.2 077900 PERFORM DELAY-FOR-30-SECS. CM1024.2 078000 PERFORM END-ROUTINE THRU PARA-Z. CM1024.2 078100 PERFORM END-ROUTINE-4. CM1024.2 078200 CLOSE PRINT-FILE. CM1024.2 078300 STOP RUN. CM1024.2 078400 SEND-AND-LOG. CM1024.2 078500 ACCEPT SYSTEM-TIME FROM TIME. CM1024.2 078600 PERFORM UNIFORM-SEND. CM1024.2 078700 ACCEPT COMP-TIME FROM TIME. CM1024.2 078800 MOVE CORR SYSTEM-TIME TO START-TIME. CM1024.2 078900 COMPUTE ELAPSED = CM1024.2 079000 (COMP-HRS * 3600 + COMP-MINS * 60 + COMP-SECS) - CM1024.2 079100 (HOURS OF SYSTEM-TIME * 3600 + MINUTES OF SYSTEM-TIME * CM1024.2 079200 60 + SECONDS OF SYSTEM-TIME). CM1024.2 079300 MOVE STATUS-KEY TO STAT. CM1024.2 079400 MOVE ERR-KEY TO ERR. CM1024.2 079500 MOVE MSG-LENGTH TO LNTH. CM1024.2 079600 MOVE LOG-LINE TO PRINT-REC. CM1024.2 079700 PERFORM WRITE-LINE. CM1024.2 079800 UNIFORM-SEND SECTION. CM1024.2 079900 UNIFORM-SEND-SWITCH. CM1024.2 080000 GO TO CM1024.2 080100 SEND-EMI-A1 CM1024.2 080200 SEND-EGI-A1 CM1024.2 080300 SEND-EMI-AP CM1024.2 080400 SEND-EMI-A3-01 CM1024.2 080500 SEND-EMI-A3-02 CM1024.2 080600 SEND-EMI-A3-03 CM1024.2 080700 SEND-EMI-A3-04 CM1024.2 080800 SEND-EMI-A3-05 CM1024.2 080900 SEND-EGI-ONLY CM1024.2 081000 SEND-EMI-BP CM1024.2 081100 SEND-EMI-B2-01 CM1024.2 081200 SEND-EMI-B2-02 CM1024.2 081300 SEND-EMI-B2-03 CM1024.2 081400 SEND-EMI-B2-04 CM1024.2 081500 SEND-EMI-B2-05 CM1024.2 081600 SEND-EMI-A0 CM1024.2 081700 SEND-EMI-B0 CM1024.2 081800 SEND-LONG-MSG CM1024.2 081900 DISABLE-OUTQUE CM1024.2 082000 ENABLE-OUTQUE CM1024.2 082100 DEPENDING ON SEND-SWITCH. CM1024.2 082200 SEND-EMI-A1. CM1024.2 082300 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI. CM1024.2 082400 GO TO UNIFORM-SEND-EXIT. CM1024.2 082500 SEND-EGI-A1. CM1024.2 082600 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EGI. CM1024.2 082700 GO TO UNIFORM-SEND-EXIT. CM1024.2 082800 SEND-EMI-AP. CM1024.2 082900 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI AFTER PAGE. CM1024.2 083000 GO TO UNIFORM-SEND-EXIT. CM1024.2 083100 SEND-EMI-A3-01. CM1024.2 083200 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI AFTER ADVANCING 3 CM1024.2 083300 LINES. CM1024.2 083400 GO TO UNIFORM-SEND-EXIT. CM1024.2 083500 SEND-EMI-A3-02. CM1024.2 083600 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 083700 AFTER ADVANCING THREE LINES. CM1024.2 083800 GO TO UNIFORM-SEND-EXIT. CM1024.2 083900 SEND-EMI-A3-03. CM1024.2 084000 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 084100 AFTER 3 LINE. CM1024.2 084200 GO TO UNIFORM-SEND-EXIT. CM1024.2 084300 SEND-EMI-A3-04. CM1024.2 084400 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 084500 AFTER COMP-THREE. CM1024.2 084600 GO TO UNIFORM-SEND-EXIT. CM1024.2 084700 SEND-EMI-A3-05. CM1024.2 084800 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 084900 AFTER 3. CM1024.2 085000 GO TO UNIFORM-SEND-EXIT. CM1024.2 085100 SEND-EGI-ONLY. CM1024.2 085200 SEND CM-OUTQUE-1 WITH EGI. CM1024.2 085300 GO TO UNIFORM-SEND-EXIT. CM1024.2 085400 SEND-EMI-BP. CM1024.2 085500 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 085600 BEFORE ADVANCING PAGE. CM1024.2 085700 GO TO UNIFORM-SEND-EXIT. CM1024.2 085800 SEND-EMI-B2-01. CM1024.2 085900 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 086000 BEFORE ADVANCING 2 LINES. CM1024.2 086100 GO TO UNIFORM-SEND-EXIT. CM1024.2 086200 SEND-EMI-B2-02. CM1024.2 086300 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 086400 BEFORE ADVANCING TWO LINES. CM1024.2 086500 GO TO UNIFORM-SEND-EXIT. CM1024.2 086600 SEND-EMI-B2-03. CM1024.2 086700 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 086800 BEFORE 2 LINE. CM1024.2 086900 GO TO UNIFORM-SEND-EXIT. CM1024.2 087000 SEND-EMI-B2-04. CM1024.2 087100 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 087200 BEFORE COMP-TWO. CM1024.2 087300 GO TO UNIFORM-SEND-EXIT. CM1024.2 087400 SEND-EMI-B2-05. CM1024.2 087500 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 087600 BEFORE 2. CM1024.2 087700 GO TO UNIFORM-SEND-EXIT. CM1024.2 087800 SEND-EMI-A0. CM1024.2 087900 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 088000 AFTER 0 LINES. CM1024.2 088100 GO TO UNIFORM-SEND-EXIT. CM1024.2 088200 SEND-EMI-B0. CM1024.2 088300 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 088400 BEFORE ZERO LINES. CM1024.2 088500 GO TO UNIFORM-SEND-EXIT. CM1024.2 088600 SEND-LONG-MSG. CM1024.2 088700 SEND CM-OUTQUE-1 FROM LONG-MSG WITH EMI AFTER PAGE. CM1024.2 088800 GO TO UNIFORM-SEND-EXIT. CM1024.2 088900 DISABLE-OUTQUE. CM1024.2 089000 DISABLE OUTPUT CM-OUTQUE-1 KEY CM1024.2 089100 PASSWORD1. CM1024.2 089200 GO TO UNIFORM-SEND-EXIT. CM1024.2 089300 ENABLE-OUTQUE. CM1024.2 089400 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 089500 XXXXX033. CM1024.2 089600 UNIFORM-SEND-EXIT. CM1024.2 089700 EXIT. CM1024.2 089800 COMMON-SUBROUTINES SECTION. CM1024.2 089900 PASS. CM1024.2 090000 MOVE "PASS" TO P-OR-F. CM1024.2 090100 FAIL. CM1024.2 090200 ADD 1 TO ERROR-COUNTER. CM1024.2 090300 MOVE "FAIL*" TO P-OR-F. CM1024.2 090400 DE-LETE. CM1024.2 090500 MOVE SPACE TO P-OR-F. CM1024.2 090600 MOVE " ************ " TO COMPUTED-A. CM1024.2 090700 MOVE " ************ " TO CORRECT-A. CM1024.2 090800 MOVE "****TEST DELETED****" TO RE-MARK. CM1024.2 090900 ADD 1 TO DELETE-CNT. CM1024.2 091000 PRINT-DETAIL. CM1024.2 091100 MOVE TEST-RESULTS TO PRINT-REC. CM1024.2 091200 PERFORM WRITE-LINE. CM1024.2 091300 MOVE SPACE TO P-OR-F. CM1024.2 091400 MOVE SPACE TO COMPUTED-A. CM1024.2 091500 MOVE SPACE TO CORRECT-A. CM1024.2 091600 COLUMN-NAMES-ROUTINE. CM1024.2 091700 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. CM1024.2 091800 PERFORM WRITE-LINE. CM1024.2 091900 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. CM1024.2 092000 PERFORM WRITE-LINE. CM1024.2 092100 PERFORM BLANK-LINE-PRINT. CM1024.2 092200 END-ROUTINE. CM1024.2 092300 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1024.2 092400 PERFORM WRITE-LINE. CM1024.2 092500 PARA-Z. CM1024.2 092600 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1024.2 092700 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1024.2 092800 PERFORM WRITE-LINE. CM1024.2 092900 END-ROUTINE-1. CM1024.2 093000 PERFORM BLANK-LINE-PRINT. CM1024.2 093100 IF ERROR-COUNTER IS EQUAL TO ZERO CM1024.2 093200 GO TO END-ROUTINE-2. CM1024.2 093300 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM1024.2 093400 GO TO END-ROUTINE-3. CM1024.2 093500 END-ROUTINE-2. CM1024.2 093600 MOVE " NO" TO ERROR-TOTAL. CM1024.2 093700 END-ROUTINE-3. CM1024.2 093800 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1024.2 093900 PERFORM WRITE-LINE. CM1024.2 094000 IF DELETE-CNT IS EQUAL TO ZERO CM1024.2 094100 MOVE " NO" TO ERROR-TOTAL ELSE CM1024.2 094200 MOVE DELETE-CNT TO ERROR-TOTAL. CM1024.2 094300 MOVE "TESTS DELETED " TO ENDER-DESC. CM1024.2 094400 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1024.2 094500 PERFORM WRITE-LINE. CM1024.2 094600 END-ROUTINE-4. CM1024.2 094700 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1024.2 094800 PERFORM WRITE-LINE. CM1024.2 094900 BLANK-LINE-PRINT. CM1024.2 095000 MOVE SPACE TO DUMMY-RECORD. CM1024.2 095100 PERFORM WRITE-LINE. CM1024.2 095200 WRITE-LINE. CM1024.2 095300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1024.2 095400 HEAD-ROUTINE. CM1024.2 095500 MOVE CCVS-H-1 TO PRINT-REC CM1024.2 095600 WRITE PRINT-REC CM1024.2 095700 AFTER ADVANCING PAGE. CM1024.2 095800 MOVE CCVS-H-2 TO PRINT-REC. CM1024.2 095900 WRITE PRINT-REC CM1024.2 096000 AFTER 2 LINES. CM1024.2 096100 MOVE CCVS-H-3 TO PRINT-REC. CM1024.2 096200 WRITE PRINT-REC CM1024.2 096300 AFTER 5 LINES. CM1024.2 096400 MOVE HYPHEN-LINE TO PRINT-REC. CM1024.2 096500 PERFORM WRITE-LINE. CM1024.2 *END-OF,CM102M *HEADER,COBOL,CM103M 000100 IDENTIFICATION DIVISION. CM1034.2 000200 PROGRAM-ID. CM1034.2 000300 CM103M. CM1034.2 000400 AUTHOR. CM1034.2 000500 FEDERAL COMPILER TESTING CENTER. CM1034.2 000600 INSTALLATION. CM1034.2 000700 GENERAL SERVICES ADMINISTRATION CM1034.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1034.2 000900 SOFTWARE DEVELOPMENT OFFICE. CM1034.2 001000 5203 LEESBURG PIKE SUITE 1100 CM1034.2 001100 FALLS CHURCH VIRGINIA 22041. CM1034.2 001200 CM1034.2 001300 PHONE (703) 756-6153 CM1034.2 001400 CM1034.2 001500 " HIGH ". CM1034.2 001600 DATE-WRITTEN. CM1034.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1034.2 001800 CREATION DATE / VALIDATION DATE CM1034.2 001900 "4.2 ". CM1034.2 002000 SECURITY. CM1034.2 002100 NONE. CM1034.2 002200 ENVIRONMENT DIVISION. CM1034.2 002300 CONFIGURATION SECTION. CM1034.2 002400 SOURCE-COMPUTER. CM1034.2 002500 XXXXX082. CM1034.2 002600 OBJECT-COMPUTER. CM1034.2 002700 XXXXX083. CM1034.2 002800 INPUT-OUTPUT SECTION. CM1034.2 002900 FILE-CONTROL. CM1034.2 003000 SELECT PRINT-FILE ASSIGN TO CM1034.2 003100 XXXXX055. CM1034.2 003200 DATA DIVISION. CM1034.2 003300 FILE SECTION. CM1034.2 003400 FD PRINT-FILE CM1034.2 003500 LABEL RECORDS CM1034.2 003600 XXXXX084 CM1034.2 003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1034.2 003800 01 PRINT-REC PICTURE X(120). CM1034.2 003900 01 DUMMY-RECORD PICTURE X(120). CM1034.2 004000 WORKING-STORAGE SECTION. CM1034.2 004100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1034.2 004200 01 REC-CT PICTURE 99 VALUE ZERO. CM1034.2 004300 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1034.2 004400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1034.2 004500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1034.2 004600 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1034.2 004700 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1034.2 004800 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1034.2 004900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1034.2 005000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1034.2 005100 01 CCVS-H-1. CM1034.2 005200 02 FILLER PICTURE X(27) VALUE SPACE. CM1034.2 005300 02 FILLER PICTURE X(67) VALUE CM1034.2 005400 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1034.2 005500- " SYSTEM". CM1034.2 005600 02 FILLER PICTURE X(26) VALUE SPACE. CM1034.2 005700 01 CCVS-H-2. CM1034.2 005800 02 FILLER PICTURE X(52) VALUE IS CM1034.2 005900 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1034.2 006000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1034.2 006100 02 TEST-ID PICTURE IS X(9). CM1034.2 006200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1034.2 006300 01 CCVS-H-3. CM1034.2 006400 02 FILLER PICTURE X(34) VALUE CM1034.2 006500 " FOR OFFICIAL USE ONLY ". CM1034.2 006600 02 FILLER PICTURE X(58) VALUE CM1034.2 006700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1034.2 006800 02 FILLER PICTURE X(28) VALUE CM1034.2 006900 " COPYRIGHT 1974 ". CM1034.2 007000 01 CCVS-E-1. CM1034.2 007100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1034.2 007200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1034.2 007300 02 ID-AGAIN PICTURE IS X(9). CM1034.2 007400 02 FILLER PICTURE X(45) VALUE IS CM1034.2 007500 " NTIS DISTRIBUTION COBOL 74". CM1034.2 007600 01 CCVS-E-2. CM1034.2 007700 02 FILLER PICTURE X(31) VALUE CM1034.2 007800 SPACE. CM1034.2 007900 02 FILLER PICTURE X(21) VALUE SPACE. CM1034.2 008000 02 CCVS-E-2-2. CM1034.2 008100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1034.2 008200 03 FILLER PICTURE IS X VALUE IS SPACE. CM1034.2 008300 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1034.2 008400 01 CCVS-E-3. CM1034.2 008500 02 FILLER PICTURE X(22) VALUE CM1034.2 008600 " FOR OFFICIAL USE ONLY". CM1034.2 008700 02 FILLER PICTURE X(12) VALUE SPACE. CM1034.2 008800 02 FILLER PICTURE X(58) VALUE CM1034.2 008900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1034.2 009000 02 FILLER PICTURE X(13) VALUE SPACE. CM1034.2 009100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1034.2 009200 01 CCVS-E-4. CM1034.2 009300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1034.2 009400 02 FILLER PIC XXXX VALUE " OF ". CM1034.2 009500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1034.2 009600 02 FILLER PIC X(40) VALUE CM1034.2 009700 " TESTS WERE EXECUTED SUCCESSFULLY". CM1034.2 009800 01 XXINFO. CM1034.2 009900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1034.2 010000 02 INFO-TEXT. CM1034.2 010100 04 FILLER PIC X(20) VALUE SPACE. CM1034.2 010200 04 XXCOMPUTED PIC X(20). CM1034.2 010300 04 FILLER PIC X(5) VALUE SPACE. CM1034.2 010400 04 XXCORRECT PIC X(20). CM1034.2 010500 01 HYPHEN-LINE. CM1034.2 010600 02 FILLER PICTURE IS X VALUE IS SPACE. CM1034.2 010700 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1034.2 010800- "*****************************************". CM1034.2 010900 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1034.2 011000- "******************************". CM1034.2 011100 01 CCVS-PGM-ID PIC X(6) VALUE CM1034.2 011200 "CM103M". CM1034.2 011300 01 MCS-TIME. CM1034.2 011400 02 HRS PIC 99. CM1034.2 011500 02 MINS PIC 99. CM1034.2 011600 02 SECS PIC 99V99. CM1034.2 011700 01 IN-TIME. CM1034.2 011800 02 IN-HRS PIC 99. CM1034.2 011900 02 IN-MINS PIC 99. CM1034.2 012000 02 IN-SECS PIC 99V99. CM1034.2 012100 01 OUT-TIME. CM1034.2 012200 02 OUT-HRS PIC 99. CM1034.2 012300 02 OUT-MINS PIC 99. CM1034.2 012400 02 OUT-SECS PIC 99V99. CM1034.2 012500 01 LOG-HDR-1. CM1034.2 012600 02 FILLER PIC X(54) VALUE SPACES. CM1034.2 012700 02 FILLER PIC X(11) VALUE "MESSAGE LOG". CM1034.2 012800 01 LOG-HDR-2. CM1034.2 012900 02 FILLER PIC X VALUE SPACE. CM1034.2 013000 02 FILLER PIC X(12) VALUE "MCS RECEIPT". CM1034.2 013100 02 FILLER PIC X(8) VALUE "PROGRAM". CM1034.2 013200 02 FILLER PIC X(9) VALUE "MCS REC". CM1034.2 013300 02 FILLER PIC X(12) VALUE "RECV SEND". CM1034.2 013400 02 FILLER PIC X(38) VALUE "MSG". CM1034.2 013500 02 FILLER PIC X(7) VALUE "MESSAGE". CM1034.2 013600 01 LOG-HDR-3. CM1034.2 013700 02 FILLER PIC XXX VALUE SPACE. CM1034.2 013800 02 FILLER PIC X(10) VALUE "INBOUND". CM1034.2 013900 02 FILLER PIC X(8) VALUE "RECEIPT". CM1034.2 014000 02 FILLER PIC X(9) VALUE "OUTB""ND". CM1034.2 014100 02 FILLER PIC X(11) VALUE "STAT STAT". CM1034.2 014200 02 FILLER PIC X(39) VALUE "LENGTH". CM1034.2 014300 02 FILLER PIC X(7) VALUE "CONTENT". CM1034.2 014400 01 LOG-HDR-4. CM1034.2 014500 02 FILLER PIC X VALUE SPACE. CM1034.2 014600 02 FILLER PIC X(11) VALUE ALL "-". CM1034.2 014700 02 FILLER PIC X VALUE SPACE. CM1034.2 014800 02 FILLER PIC X(7) VALUE ALL "-". CM1034.2 014900 02 FILLER PIC X VALUE SPACE. CM1034.2 015000 02 FILLER PIC X(7) VALUE ALL "-". CM1034.2 015100 02 FILLER PIC XX VALUE SPACES. CM1034.2 015200 02 FILLER PIC X(11) VALUE "---- ----". CM1034.2 015300 02 FILLER PIC X(5) VALUE ALL "-". CM1034.2 015400 02 FILLER PIC XX VALUE SPACES. CM1034.2 015500 02 FILLER PIC X(72) VALUE ALL "-". CM1034.2 015600 01 LOG-LINE. CM1034.2 015700 02 FILLER PIC X VALUE SPACE. CM1034.2 015800 02 TIME-REC. CM1034.2 015900 03 HRS PIC 99. CM1034.2 016000 03 FILLER PIC X VALUE ":". CM1034.2 016100 03 MINS PIC 99. CM1034.2 016200 03 FILLER PIC X VALUE ":". CM1034.2 016300 03 SECS PIC 99.99. CM1034.2 016400 02 FILLER PIC X VALUE SPACE. CM1034.2 016500 02 PROG-TIME PIC ---.99. CM1034.2 016600 02 FILLER PIC XX VALUE SPACES. CM1034.2 016700 02 TIME-SENT PIC ---.99. CM1034.2 016800 02 FILLER PIC XXXX VALUE SPACES. CM1034.2 016900 02 RECV-STATUS PIC XX. CM1034.2 017000 02 FILLER PIC XX VALUE SPACES. CM1034.2 017100 02 SEND-STATUS PIC XX. CM1034.2 017200 02 FILLER PIC X VALUE "/". CM1034.2 017300 02 SEND-ERR PIC X. CM1034.2 017400 02 FILLER PIC XXX VALUE SPACES. CM1034.2 017500 02 MSG-LNGTH PIC ZZ9. CM1034.2 017600 02 FILLER PIC XXX VALUE SPACES. CM1034.2 017700 02 MSG. CM1034.2 017800 03 KILL-FIELD PIC X(4). CM1034.2 017900 03 FILLER PIC X(68). CM1034.2 018000 COMMUNICATION SECTION. CM1034.2 018100 CD CM-INQUE-1 FOR INPUT CM1034.2 018200 MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3 FILLER TIME-RECEIVEDCM1034.2 018300 FILLER IN-LENGTH END-KEY IN-STATUS FILLER. CM1034.2 018400 CD CM-OUTQUE-1 FOR OUTPUT. CM1034.2 018500 01 OUTQUE-SPECIFICATIONS. CM1034.2 018600 02 ONE PIC 9999 VALUE IS 1. CM1034.2 018700 02 OUT-LENGTH PIC 9999. CM1034.2 018800 02 OUT-STATUS PIC XX. CM1034.2 018900 02 ERR-KEY PIC X. CM1034.2 019000 02 SYM-DEST PIC X(12) VALUE IS CM1034.2 019100 XXXXX032. CM1034.2 019200 PROCEDURE DIVISION. CM1034.2 019300 SECT-CM103M-0001 SECTION. CM1034.2 019400 CM103M-INIT. CM1034.2 019500 OPEN OUTPUT PRINT-FILE. CM1034.2 019600 MOVE "CM103M " TO TEST-ID. CM1034.2 019700 MOVE TEST-ID TO ID-AGAIN. CM1034.2 019800 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1034.2 019900 MOVE CM1034.2 020000 XXXXX030 CM1034.2 020100 TO MAIN-QUEUE. CM1034.2 020200 ENABLE INPUT CM-INQUE-1 WITH KEY CM1034.2 020300 XXXXX031. CM1034.2 020400 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1034.2 020500 XXXXX033. CM1034.2 020600 PERFORM HEAD-ROUTINE. CM1034.2 020700 PERFORM LOG-HEADER. CM1034.2 020800 RECEIVE-ECHO-AND-LOG. CM1034.2 020900 MOVE SPACES TO MSG. CM1034.2 021000 RECEIVE CM-INQUE-1 MESSAGE INTO MSG. CM1034.2 021100 ACCEPT IN-TIME FROM TIME. CM1034.2 021200 IF IN-LENGTH IS GREATER THAN 72 CM1034.2 021300 MOVE 72 TO OUT-LENGTH CM1034.2 021400 ELSE MOVE IN-LENGTH TO OUT-LENGTH. CM1034.2 021500 SEND CM-OUTQUE-1 FROM MSG WITH EMI. CM1034.2 021600 ACCEPT OUT-TIME FROM TIME. CM1034.2 021700 MOVE TIME-RECEIVED TO MCS-TIME. CM1034.2 021800 MOVE CORR MCS-TIME TO TIME-REC. CM1034.2 021900 COMPUTE PROG-TIME = CM1034.2 022000 (IN-HRS * 3600 + IN-MINS * 60 + IN-SECS) - CM1034.2 022100 (HRS OF MCS-TIME * 3600 + MINS OF MCS-TIME * 60 + CM1034.2 022200 SECS OF MCS-TIME). CM1034.2 022300 COMPUTE TIME-SENT = CM1034.2 022400 (OUT-HRS * 3600 + OUT-MINS * 60 + OUT-SECS) - CM1034.2 022500 (HRS OF MCS-TIME * 3600 + MINS OF MCS-TIME * 60 + CM1034.2 022600 SECS OF MCS-TIME). CM1034.2 022700 MOVE IN-STATUS TO RECV-STATUS. CM1034.2 022800 MOVE OUT-STATUS TO SEND-STATUS. CM1034.2 022900 MOVE ERR-KEY TO SEND-ERR. CM1034.2 023000 MOVE IN-LENGTH TO MSG-LNGTH. CM1034.2 023100 MOVE LOG-LINE TO PRINT-REC. CM1034.2 023200 WRITE PRINT-REC. CM1034.2 023300 IF KILL-FIELD IS NOT EQUAL TO "KILL" CM1034.2 023400 GO TO RECEIVE-ECHO-AND-LOG. CM1034.2 023500 PERFORM END-ROUTINE THRU END-ROUTINE-3. CM1034.2 023600 CLOSE PRINT-FILE. CM1034.2 023700 STOP RUN. CM1034.2 023800 END-ROUTINE. CM1034.2 023900 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1034.2 024000 PERFORM WRITE-LINE. CM1034.2 024100 PARA-Z. CM1034.2 024200 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1034.2 024300 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1034.2 024400 PERFORM WRITE-LINE. CM1034.2 024500 END-ROUTINE-3. CM1034.2 024600 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1034.2 024700 PERFORM WRITE-LINE. CM1034.2 024800 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1034.2 024900 PERFORM WRITE-LINE. CM1034.2 025000 BLANK-LINE-PRINT. CM1034.2 025100 MOVE SPACE TO DUMMY-RECORD. CM1034.2 025200 PERFORM WRITE-LINE. CM1034.2 025300 WRITE-LINE. CM1034.2 025400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1034.2 025500 LOG-HEADER. CM1034.2 025600 MOVE LOG-HDR-1 TO PRINT-REC CM1034.2 025700 WRITE PRINT-REC CM1034.2 025800 AFTER 3 LINES. CM1034.2 025900 MOVE LOG-HDR-2 TO PRINT-REC. CM1034.2 026000 WRITE PRINT-REC CM1034.2 026100 AFTER 3 LINES. CM1034.2 026200 MOVE LOG-HDR-3 TO PRINT-REC. CM1034.2 026300 WRITE PRINT-REC CM1034.2 026400 MOVE LOG-HDR-4 TO PRINT-REC. CM1034.2 026500 PERFORM WRITE-LINE. CM1034.2 026600 MOVE SPACES TO PRINT-REC. CM1034.2 026700 PERFORM WRITE-LINE. CM1034.2 026800 HEAD-ROUTINE. CM1034.2 026900 MOVE CCVS-H-1 TO PRINT-REC CM1034.2 027000 WRITE PRINT-REC CM1034.2 027100 AFTER ADVANCING PAGE. CM1034.2 027200 MOVE CCVS-H-2 TO PRINT-REC. CM1034.2 027300 WRITE PRINT-REC CM1034.2 027400 AFTER 2 LINES. CM1034.2 027500 MOVE CCVS-H-3 TO PRINT-REC. CM1034.2 027600 WRITE PRINT-REC CM1034.2 027700 AFTER 5 LINES. CM1034.2 027800 MOVE HYPHEN-LINE TO PRINT-REC. CM1034.2 027900 PERFORM WRITE-LINE. CM1034.2 *END-OF,CM103M *HEADER,COBOL,CM104M 000100 IDENTIFICATION DIVISION. CM1044.2 000200 PROGRAM-ID. CM1044.2 000300 CM104M. CM1044.2 000400 AUTHOR. CM1044.2 000500 FEDERAL COMPILER TESTING CENTER. CM1044.2 000600 INSTALLATION. CM1044.2 000700 GENERAL SERVICES ADMINISTRATION CM1044.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1044.2 000900 SOFTWARE DEVELOPMENT OFFICE. CM1044.2 001000 5203 LEESBURG PIKE SUITE 1100 CM1044.2 001100 FALLS CHURCH VIRGINIA 22041. CM1044.2 001200 CM1044.2 001300 PHONE (703) 756-6153 CM1044.2 001400 CM1044.2 001500 " HIGH ". CM1044.2 001600 DATE-WRITTEN. CM1044.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1044.2 001800 CREATION DATE / VALIDATION DATE CM1044.2 001900 "4.2 ". CM1044.2 002000 SECURITY. CM1044.2 002100 NONE. CM1044.2 002200 ENVIRONMENT DIVISION. CM1044.2 002300 CONFIGURATION SECTION. CM1044.2 002400 SOURCE-COMPUTER. CM1044.2 002500 XXXXX082. CM1044.2 002600 OBJECT-COMPUTER. CM1044.2 002700 XXXXX083. CM1044.2 002800 INPUT-OUTPUT SECTION. CM1044.2 002900 FILE-CONTROL. CM1044.2 003000 SELECT PRINT-FILE ASSIGN TO CM1044.2 003100 XXXXX055. CM1044.2 003200 DATA DIVISION. CM1044.2 003300 FILE SECTION. CM1044.2 003400 FD PRINT-FILE CM1044.2 003500 LABEL RECORDS CM1044.2 003600 XXXXX084 CM1044.2 003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1044.2 003800 01 PRINT-REC PICTURE X(120). CM1044.2 003900 01 DUMMY-RECORD PICTURE X(120). CM1044.2 004000 WORKING-STORAGE SECTION. CM1044.2 004100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1044.2 004200 01 REC-CT PICTURE 99 VALUE ZERO. CM1044.2 004300 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1044.2 004400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1044.2 004500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1044.2 004600 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1044.2 004700 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1044.2 004800 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1044.2 004900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1044.2 005000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1044.2 005100 01 CCVS-H-1. CM1044.2 005200 02 FILLER PICTURE X(27) VALUE SPACE. CM1044.2 005300 02 FILLER PICTURE X(67) VALUE CM1044.2 005400 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1044.2 005500- " SYSTEM". CM1044.2 005600 02 FILLER PICTURE X(26) VALUE SPACE. CM1044.2 005700 01 CCVS-H-2. CM1044.2 005800 02 FILLER PICTURE X(52) VALUE IS CM1044.2 005900 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1044.2 006000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1044.2 006100 02 TEST-ID PICTURE IS X(9). CM1044.2 006200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1044.2 006300 01 CCVS-H-3. CM1044.2 006400 02 FILLER PICTURE X(34) VALUE CM1044.2 006500 " FOR OFFICIAL USE ONLY ". CM1044.2 006600 02 FILLER PICTURE X(58) VALUE CM1044.2 006700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1044.2 006800 02 FILLER PICTURE X(28) VALUE CM1044.2 006900 " COPYRIGHT 1974 ". CM1044.2 007000 01 CCVS-E-1. CM1044.2 007100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1044.2 007200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1044.2 007300 02 ID-AGAIN PICTURE IS X(9). CM1044.2 007400 02 FILLER PICTURE X(45) VALUE IS CM1044.2 007500 " NTIS DISTRIBUTION COBOL 74". CM1044.2 007600 01 CCVS-E-2. CM1044.2 007700 02 FILLER PICTURE X(31) VALUE CM1044.2 007800 SPACE. CM1044.2 007900 02 FILLER PICTURE X(21) VALUE SPACE. CM1044.2 008000 02 CCVS-E-2-2. CM1044.2 008100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1044.2 008200 03 FILLER PICTURE IS X VALUE IS SPACE. CM1044.2 008300 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1044.2 008400 01 CCVS-E-3. CM1044.2 008500 02 FILLER PICTURE X(22) VALUE CM1044.2 008600 " FOR OFFICIAL USE ONLY". CM1044.2 008700 02 FILLER PICTURE X(12) VALUE SPACE. CM1044.2 008800 02 FILLER PICTURE X(58) VALUE CM1044.2 008900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1044.2 009000 02 FILLER PICTURE X(13) VALUE SPACE. CM1044.2 009100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1044.2 009200 01 CCVS-E-4. CM1044.2 009300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1044.2 009400 02 FILLER PIC XXXX VALUE " OF ". CM1044.2 009500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1044.2 009600 02 FILLER PIC X(40) VALUE CM1044.2 009700 " TESTS WERE EXECUTED SUCCESSFULLY". CM1044.2 009800 01 XXINFO. CM1044.2 009900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1044.2 010000 02 INFO-TEXT. CM1044.2 010100 04 FILLER PIC X(20) VALUE SPACE. CM1044.2 010200 04 XXCOMPUTED PIC X(20). CM1044.2 010300 04 FILLER PIC X(5) VALUE SPACE. CM1044.2 010400 04 XXCORRECT PIC X(20). CM1044.2 010500 01 HYPHEN-LINE. CM1044.2 010600 02 FILLER PICTURE IS X VALUE IS SPACE. CM1044.2 010700 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1044.2 010800- "*****************************************". CM1044.2 010900 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1044.2 011000- "******************************". CM1044.2 011100 01 CCVS-PGM-ID PIC X(6) VALUE CM1044.2 011200 "CM104M". CM1044.2 011300 01 LOG-HDR-1. CM1044.2 011400 02 FILLER PIC X(54) VALUE SPACES. CM1044.2 011500 02 FILLER PIC X(11) VALUE "MESSAGE LOG". CM1044.2 011600 01 LOG-HDR-2. CM1044.2 011700 02 FILLER PIC XXX VALUE SPACES. CM1044.2 011800 02 FILLER PIC X(12) VALUE "SYMBOLIC". CM1044.2 011900 02 FILLER PIC X(15) VALUE "TIME MCS". CM1044.2 012000 02 FILLER PIC X(6) VALUE "SEND". CM1044.2 012100 02 FILLER PIC X(4) VALUE "MSG". CM1044.2 012200 02 FILLER PIC XXX VALUE "IN". CM1044.2 012300 02 FILLER PIC X(3) VALUE "OUT". CM1044.2 012400 01 LOG-HDR-3. CM1044.2 012500 02 FILLER PIC X(4) VALUE SPACES. CM1044.2 012600 02 FILLER PIC X(11) VALUE "SOURCE". CM1044.2 012700 02 FILLER PIC X(11) VALUE "RECEIVED". CM1044.2 012800 02 FILLER PIC XXX VALUE "QD". CM1044.2 012900 02 FILLER PIC X(7) VALUE "COMPLT". CM1044.2 013000 02 FILLER PIC X(4) VALUE "LTH". CM1044.2 013100 02 FILLER PIC XXX VALUE "ST". CM1044.2 013200 02 FILLER PIC X(33) VALUE "STAT". CM1044.2 013300 02 FILLER PIC X(16) VALUE "MESSAGE CONTENTS". CM1044.2 013400 01 LOG-HDR-4. CM1044.2 013500 02 FILLER PIC X VALUE SPACE. CM1044.2 013600 02 FILLER PIC X(12) VALUE ALL "-". CM1044.2 013700 02 FILLER PIC X VALUE SPACE. CM1044.2 013800 02 FILLER PIC X(11) VALUE ALL "-". CM1044.2 013900 02 FILLER PIC X VALUE SPACE. CM1044.2 014000 02 FILLER PIC XXX VALUE "--". CM1044.2 014100 02 FILLER PIC X(6) VALUE ALL "-". CM1044.2 014200 02 FILLER PIC X VALUE SPACE. CM1044.2 014300 02 FILLER PIC X(4) VALUE "---". CM1044.2 014400 02 FILLER PIC XXX VALUE "--". CM1044.2 014500 02 FILLER PIC X(5) VALUE "----". CM1044.2 014600 02 FILLER PIC X(72) VALUE ALL "-". CM1044.2 014700 01 LOG-LINE. CM1044.2 014800 02 FILLER PIC X VALUE SPACE. CM1044.2 014900 02 SYM-SOURCE PIC X(12). CM1044.2 015000 02 FILLER PIC X VALUE SPACE. CM1044.2 015100 02 LOG-TIME. CM1044.2 015200 03 HRS PIC 99. CM1044.2 015300 03 FILLER PIC X VALUE ":". CM1044.2 015400 03 MINS PIC 99. CM1044.2 015500 03 FILLER PIC X VALUE ":". CM1044.2 015600 03 SECS PIC 99.99. CM1044.2 015700 02 FILLER PIC X VALUE SPACE. CM1044.2 015800 02 QUEUE-DEPTH PIC Z9. CM1044.2 015900 02 OUT-TIME PIC -(4).99. CM1044.2 016000 02 FILLER PIC X VALUE SPACE. CM1044.2 016100 02 MSG-LENGTH PIC ZZ9. CM1044.2 016200 02 FILLER PIC X VALUE SPACE. CM1044.2 016300 02 IN-STATUS PIC XX. CM1044.2 016400 02 FILLER PIC X VALUE SPACE. CM1044.2 016500 02 OUT-STATUS PIC XX. CM1044.2 016600 02 FILLER PIC X VALUE "/". CM1044.2 016700 02 OUT-ERR-KEY PIC X. CM1044.2 016800 02 FILLER PIC X VALUE SPACE. CM1044.2 016900 02 MSG. CM1044.2 017000 03 KILL-FIELD PIC X(4). CM1044.2 017100 03 FILLER PIC X(68). CM1044.2 017200 01 SEND-TIME. CM1044.2 017300 02 S-HRS PIC 99. CM1044.2 017400 02 S-MINS PIC 99. CM1044.2 017500 02 S-SECS PIC 99V99. CM1044.2 017600 COMMUNICATION SECTION. CM1044.2 017700 CD CM-INQUE-1 FOR INPUT. CM1044.2 017800 01 INQUE-1-SPECIFICATIONS. CM1044.2 017900 02 QUEUE-1 PIC X(24) VALUE CM1044.2 018000 XXXXX030. CM1044.2 018100 02 FILLER PIC X(30) VALUE SPACES. CM1044.2 018200 02 TIME-RECEIVED-1. CM1044.2 018300 03 HRS PIC 99. CM1044.2 018400 03 MINS PIC 99. CM1044.2 018500 03 SECS PIC 99V99. CM1044.2 018600 02 SOURCE-1 PIC X(12). CM1044.2 018700 02 IN-LENGTH-1 PIC 9(4). CM1044.2 018800 02 END-KEY-1 PIC X. CM1044.2 018900 02 IN-STATUS-1 PIC XX. CM1044.2 019000 02 MSG-COUNT-1 PIC 9(6). CM1044.2 019100 01 INQUE-1-DUMMY-RECORD PIC X(87). CM1044.2 019200 01 INQUE-1-DUMMY-TABLE. CM1044.2 019300 02 DUMMY-NAME PIC 9 OCCURS 87 TIMES INDEXED BY I1. CM1044.2 019400 CD CM-OUTQUE-1 FOR OUTPUT. CM1044.2 019500 01 OUTQUE-1-SPECIFIACTIONS. CM1044.2 019600 02 DEST-COUNT-1 PIC 9(4) VALUE IS 1. CM1044.2 019700 02 OUT-LENGTH-1 PIC 9(4). CM1044.2 019800 02 OUT-STATUS-1 PIC XX. CM1044.2 019900 02 ERR-KEY-1 PIC X. CM1044.2 020000 02 SYM-DEST-1 PIC X(12) VALUE CM1044.2 020100 XXXXX032. CM1044.2 020200 01 OUTQUE-1-DUMMY-RECORD PIC X(23). CM1044.2 020300 01 OUTQUE-1-DUMMY-TABLE. CM1044.2 020400 02 DUMMY-NAME OCCURS 23 TIMES PIC X. CM1044.2 020500 CD CM-INQUE-2 FOR INPUT CM1044.2 020600 FILLER FILLER FILLER FILLER FILLER FILLER SOURCE-2 CM1044.2 020700 IN-LENGTH-2 END-KEY-2 IN-STATUS-2 MSG-COUNT-2. CM1044.2 020800 01 INQUE-2-RECORD. CM1044.2 020900 02 FILLER PIC X(54) VALUE CM1044.2 021000 XXXXX034. CM1044.2 021100 02 TIME-RECEIVED-2. CM1044.2 021200 03 HRS PIC 99. CM1044.2 021300 03 MINS PIC 99. CM1044.2 021400 03 SECS PIC 99V99. CM1044.2 021500 02 FILLER PIC X(25). CM1044.2 021600 CD CM-OUTQUE-2 FOR OUTPUT CM1044.2 021700 TEXT LENGTH OUT-LENGTH-2 CM1044.2 021800 STATUS KEY OUT-STATUS-2 CM1044.2 021900 ERROR KEY ERR-KEY-2. CM1044.2 022000 01 OUTQUE-2-RECORD. CM1044.2 022100 02 FILLER PIC 9(4) VALUE 1. CM1044.2 022200 02 FILLER PIC X(7) VALUE SPACES. CM1044.2 022300 02 FILLER PIC X(12) VALUE CM1044.2 022400 XXXXX035. CM1044.2 022500 PROCEDURE DIVISION. CM1044.2 022600 SECT-CM104M-0001 SECTION. CM1044.2 022700 CM104M-INIT. CM1044.2 022800 OPEN OUTPUT PRINT-FILE. CM1044.2 022900 MOVE "CM104M " TO TEST-ID. CM1044.2 023000 MOVE TEST-ID TO ID-AGAIN. CM1044.2 023100 PERFORM HEAD-ROUTINE. CM1044.2 023200 PERFORM LOG-HEADER. CM1044.2 023300 ENABLE INPUT CM-INQUE-1 WITH KEY CM1044.2 023400 XXXXX031. CM1044.2 023500 ENABLE INPUT CM-INQUE-2 WITH KEY CM1044.2 023600 XXXXX036. CM1044.2 023700 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1044.2 023800 XXXXX033. CM1044.2 023900 ENABLE OUTPUT CM-OUTQUE-2 WITH KEY CM1044.2 024000 XXXXX037. CM1044.2 024100 CM104M-POLL-1. CM1044.2 024200 MOVE SPACES TO MSG. CM1044.2 024300 RECEIVE CM-INQUE-1 MESSAGE INTO MSG CM1044.2 024400 NO DATA GO TO CM104M-POLL-2. CM1044.2 024500 ACCEPT CM-INQUE-1 COUNT. CM1044.2 024600 IF IN-LENGTH-1 IS GREATER THAN 72 CM1044.2 024700 MOVE 72 TO OUT-LENGTH-2 CM1044.2 024800 ELSE MOVE IN-LENGTH-1 TO OUT-LENGTH-2. CM1044.2 024900 SEND CM-OUTQUE-2 FROM MSG WITH EMI. CM1044.2 025000 ACCEPT SEND-TIME FROM TIME. CM1044.2 025100 MOVE SOURCE-1 TO SYM-SOURCE. CM1044.2 025200 MOVE CORR TIME-RECEIVED-1 TO LOG-TIME. CM1044.2 025300 COMPUTE OUT-TIME = CM1044.2 025400 (S-HRS * 3600 + S-MINS * 60 + S-SECS) - CM1044.2 025500 (HRS OF TIME-RECEIVED-1 * 3600 + MINS OF TIME-RECEIVED-1 CM1044.2 025600 * 60 + SECS OF TIME-RECEIVED-1). CM1044.2 025700 MOVE MSG-COUNT-1 TO QUEUE-DEPTH. CM1044.2 025800 MOVE IN-LENGTH-1 TO MSG-LENGTH. CM1044.2 025900 MOVE IN-STATUS-1 TO IN-STATUS. CM1044.2 026000 MOVE OUT-STATUS-2 TO OUT-STATUS. CM1044.2 026100 MOVE ERR-KEY-2 TO OUT-ERR-KEY. CM1044.2 026200 MOVE LOG-LINE TO PRINT-REC. CM1044.2 026300 WRITE PRINT-REC. CM1044.2 026400 IF KILL-FIELD IS EQUAL TO "KILL" GO TO CM104M-FINI. CM1044.2 026500 CM104M-POLL-2. CM1044.2 026600 MOVE SPACES TO MSG. CM1044.2 026700 RECEIVE CM-INQUE-2 MESSAGE INTO MSG CM1044.2 026800 NO DATA GO TO CM104M-POLL-1. CM1044.2 026900 ACCEPT CM-INQUE-2 COUNT. CM1044.2 027000 IF IN-LENGTH-2 IS GREATER THAN 72 CM1044.2 027100 MOVE 72 TO OUT-LENGTH-1 CM1044.2 027200 ELSE MOVE IN-LENGTH-2 TO OUT-LENGTH-1. CM1044.2 027300 SEND CM-OUTQUE-1 FROM MSG WITH EMI. CM1044.2 027400 ACCEPT SEND-TIME FROM TIME. CM1044.2 027500 MOVE SOURCE-2 TO SYM-SOURCE. CM1044.2 027600 MOVE CORR TIME-RECEIVED-2 TO LOG-TIME. CM1044.2 027700 COMPUTE OUT-TIME = CM1044.2 027800 (S-HRS * 3600 + S-MINS * 60 + S-SECS) - CM1044.2 027900 (HRS OF TIME-RECEIVED-2 * 3600 + MINS OF TIME-RECEIVED-2 CM1044.2 028000 * 60 + SECS OF TIME-RECEIVED-2). CM1044.2 028100 MOVE MSG-COUNT-2 TO QUEUE-DEPTH. CM1044.2 028200 MOVE IN-LENGTH-2 TO MSG-LENGTH. CM1044.2 028300 MOVE IN-STATUS-2 TO IN-STATUS. CM1044.2 028400 MOVE OUT-STATUS-1 TO OUT-STATUS. CM1044.2 028500 MOVE ERR-KEY-1 TO OUT-ERR-KEY. CM1044.2 028600 MOVE LOG-LINE TO PRINT-REC. CM1044.2 028700 WRITE PRINT-REC. CM1044.2 028800 IF KILL-FIELD IS EQUAL TO "KILL" GO TO CM104M-FINI. CM1044.2 028900 GO TO CM104M-POLL-1. CM1044.2 029000 CM104M-FINI. CM1044.2 029100 PERFORM END-ROUTINE THRU END-ROUTINE-3. CM1044.2 029200 CLOSE PRINT-FILE. CM1044.2 029300 STOP RUN. CM1044.2 029400 END-ROUTINE. CM1044.2 029500 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1044.2 029600 PERFORM WRITE-LINE. CM1044.2 029700 PARA-Z. CM1044.2 029800 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1044.2 029900 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1044.2 030000 PERFORM WRITE-LINE. CM1044.2 030100 END-ROUTINE-3. CM1044.2 030200 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1044.2 030300 PERFORM WRITE-LINE. CM1044.2 030400 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1044.2 030500 PERFORM WRITE-LINE. CM1044.2 030600 BLANK-LINE-PRINT. CM1044.2 030700 MOVE SPACE TO DUMMY-RECORD. CM1044.2 030800 PERFORM WRITE-LINE. CM1044.2 030900 WRITE-LINE. CM1044.2 031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1044.2 031100 LOG-HEADER. CM1044.2 031200 MOVE LOG-HDR-1 TO PRINT-REC CM1044.2 031300 WRITE PRINT-REC CM1044.2 031400 AFTER 3 LINES. CM1044.2 031500 MOVE LOG-HDR-2 TO PRINT-REC. CM1044.2 031600 WRITE PRINT-REC CM1044.2 031700 AFTER 3 LINES. CM1044.2 031800 MOVE LOG-HDR-3 TO PRINT-REC. CM1044.2 031900 WRITE PRINT-REC CM1044.2 032000 MOVE LOG-HDR-4 TO PRINT-REC. CM1044.2 032100 PERFORM WRITE-LINE. CM1044.2 032200 MOVE SPACES TO PRINT-REC. CM1044.2 032300 PERFORM WRITE-LINE. CM1044.2 032400 HEAD-ROUTINE. CM1044.2 032500 MOVE CCVS-H-1 TO PRINT-REC CM1044.2 032600 WRITE PRINT-REC CM1044.2 032700 AFTER ADVANCING PAGE. CM1044.2 032800 MOVE CCVS-H-2 TO PRINT-REC. CM1044.2 032900 WRITE PRINT-REC CM1044.2 033000 AFTER 2 LINES. CM1044.2 033100 MOVE CCVS-H-3 TO PRINT-REC. CM1044.2 033200 WRITE PRINT-REC CM1044.2 033300 AFTER 5 LINES. CM1044.2 033400 MOVE HYPHEN-LINE TO PRINT-REC. CM1044.2 033500 PERFORM WRITE-LINE. CM1044.2 *END-OF,CM104M *HEADER,COBOL,CM105M 000100 IDENTIFICATION DIVISION. CM1054.2 000200 PROGRAM-ID. CM1054.2 000300 CM105M. CM1054.2 000400 AUTHOR. CM1054.2 000500 FEDERAL COMPILER TESTING CENTER. CM1054.2 000600 INSTALLATION. CM1054.2 000700 GENERAL SERVICES ADMINISTRATION CM1054.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1054.2 000900 SOFTWARE DEVELOPMENT OFFICE. CM1054.2 001000 5203 LEESBURG PIKE SUITE 1100 CM1054.2 001100 FALLS CHURCH VIRGINIA 22041. CM1054.2 001200 CM1054.2 001300 PHONE (703) 756-6153 CM1054.2 001400 CM1054.2 001500 " HIGH ". CM1054.2 001600 DATE-WRITTEN. CM1054.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1054.2 001800 CREATION DATE / VALIDATION DATE CM1054.2 001900 "4.2 ". CM1054.2 002000 SECURITY. CM1054.2 002100 NONE. CM1054.2 002200 ENVIRONMENT DIVISION. CM1054.2 002300 CONFIGURATION SECTION. CM1054.2 002400 SOURCE-COMPUTER. CM1054.2 002500 XXXXX082. CM1054.2 002600 OBJECT-COMPUTER. CM1054.2 002700 XXXXX083. CM1054.2 002800 INPUT-OUTPUT SECTION. CM1054.2 002900 FILE-CONTROL. CM1054.2 003000 SELECT PRINT-FILE ASSIGN TO CM1054.2 003100 XXXXX055. CM1054.2 003200 DATA DIVISION. CM1054.2 003300 FILE SECTION. CM1054.2 003400 FD PRINT-FILE CM1054.2 003500 LABEL RECORDS CM1054.2 003600 XXXXX084 CM1054.2 003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1054.2 003800 01 PRINT-REC PICTURE X(120). CM1054.2 003900 01 DUMMY-RECORD PICTURE X(120). CM1054.2 004000 WORKING-STORAGE SECTION. CM1054.2 004100 77 P PIC X(12). CM1054.2 004200 77 PP PIC X(24). CM1054.2 004300 77 PPP PIC X(36). CM1054.2 004400 77 PS PIC X(24). CM1054.2 004500 77 PSP PIC X(36). CM1054.2 004600 77 PPS PIC X(36). CM1054.2 004700 01 QUEUE-NAMES. CM1054.2 004800 02 PPPP PIC X(48) VALUE CM1054.2 004900 XXXXX038. CM1054.2 005000 02 PPPS PIC X(48) VALUE CM1054.2 005100 XXXXX039. CM1054.2 005200 02 PPSP PIC X(48) VALUE CM1054.2 005300 XXXXX040. CM1054.2 005400 02 PSPP PIC X(48) VALUE CM1054.2 005500 XXXXX041. CM1054.2 005600 01 QUEUE-NAMES-TABLE REDEFINES QUEUE-NAMES. CM1054.2 005700 02 NAME-SET PIC X(48) OCCURS 4 TIMES INDEXED BY I1. CM1054.2 005800 01 TEST-RESULTS. CM1054.2 005900 02 FILLER PICTURE X VALUE SPACE. CM1054.2 006000 02 FEATURE PICTURE X(18). CM1054.2 006100 02 FILLER PICTURE X VALUE SPACE. CM1054.2 006200 02 P-OR-F PICTURE X(5). CM1054.2 006300 02 FILLER PICTURE X VALUE SPACE. CM1054.2 006400 02 PAR-NAME PIC X(20). CM1054.2 006500 02 FILLER PICTURE X VALUE SPACE. CM1054.2 006600 02 COMPUTED-A. CM1054.2 006700 03 FILLER PIC X(9) VALUE SPACE. CM1054.2 006800 03 STAT PIC XX. CM1054.2 006900 03 FILLER PIC X(9) VALUE SPACE. CM1054.2 007000 02 FILLER PICTURE X VALUE SPACE. CM1054.2 007100 02 CORRECT-A. CM1054.2 007200 03 FILLER PIC X(8). CM1054.2 007300 03 CORRECT-QUEUE PIC X(4). CM1054.2 007400 03 FILLER PIC X(8). CM1054.2 007500 02 FILLER PICTURE X VALUE SPACE. CM1054.2 007600 02 RE-MARK. CM1054.2 007700 03 QUEUE-KEY PIC X(4). CM1054.2 007800 03 FILLER PIC X(26). CM1054.2 007900 01 COLUMNS-LINE-1. CM1054.2 008000 02 FILLER PIC X(3) VALUE SPACES. CM1054.2 008100 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM1054.2 008200 02 FILLER PIC X(9) VALUE "RESLT". CM1054.2 008300 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM1054.2 008400 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM1054.2 008500 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM1054.2 008600 02 FILLER PIC X(7) VALUE "REMARKS". CM1054.2 008700 01 COLUMNS-LINE-2. CM1054.2 008800 02 FILLER PIC X VALUE SPACE. CM1054.2 008900 02 FILLER PIC X(18) VALUE ALL "-". CM1054.2 009000 02 FILLER PIC X VALUE SPACE. CM1054.2 009100 02 FILLER PIC X(5) VALUE ALL "-". CM1054.2 009200 02 FILLER PIC X VALUE SPACE. CM1054.2 009300 02 FILLER PIC X(20) VALUE ALL "-". CM1054.2 009400 02 FILLER PIC X VALUE SPACE. CM1054.2 009500 02 FILLER PIC X(20) VALUE ALL "-". CM1054.2 009600 02 FILLER PIC X VALUE SPACE. CM1054.2 009700 02 FILLER PIC X(20) VALUE ALL "-". CM1054.2 009800 02 FILLER PIC X VALUE SPACE. CM1054.2 009900 02 FILLER PIC X(31) VALUE ALL "-". CM1054.2 010000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1054.2 010100 01 REC-CT PICTURE 99 VALUE ZERO. CM1054.2 010200 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1054.2 010300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1054.2 010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1054.2 010500 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1054.2 010600 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1054.2 010700 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1054.2 010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1054.2 010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1054.2 011000 01 CCVS-H-1. CM1054.2 011100 02 FILLER PICTURE X(27) VALUE SPACE. CM1054.2 011200 02 FILLER PICTURE X(67) VALUE CM1054.2 011300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1054.2 011400- " SYSTEM". CM1054.2 011500 02 FILLER PICTURE X(26) VALUE SPACE. CM1054.2 011600 01 CCVS-H-2. CM1054.2 011700 02 FILLER PICTURE X(52) VALUE IS CM1054.2 011800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1054.2 011900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1054.2 012000 02 TEST-ID PICTURE IS X(9). CM1054.2 012100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1054.2 012200 01 CCVS-H-3. CM1054.2 012300 02 FILLER PICTURE X(34) VALUE CM1054.2 012400 " FOR OFFICIAL USE ONLY ". CM1054.2 012500 02 FILLER PICTURE X(58) VALUE CM1054.2 012600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1054.2 012700 02 FILLER PICTURE X(28) VALUE CM1054.2 012800 " COPYRIGHT 1974 ". CM1054.2 012900 01 CCVS-E-1. CM1054.2 013000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1054.2 013100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1054.2 013200 02 ID-AGAIN PICTURE IS X(9). CM1054.2 013300 02 FILLER PICTURE X(45) VALUE IS CM1054.2 013400 " NTIS DISTRIBUTION COBOL 74". CM1054.2 013500 01 CCVS-E-2. CM1054.2 013600 02 FILLER PICTURE X(31) VALUE CM1054.2 013700 SPACE. CM1054.2 013800 02 FILLER PICTURE X(21) VALUE SPACE. CM1054.2 013900 02 CCVS-E-2-2. CM1054.2 014000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1054.2 014100 03 FILLER PICTURE IS X VALUE IS SPACE. CM1054.2 014200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1054.2 014300 01 CCVS-E-3. CM1054.2 014400 02 FILLER PICTURE X(22) VALUE CM1054.2 014500 " FOR OFFICIAL USE ONLY". CM1054.2 014600 02 FILLER PICTURE X(12) VALUE SPACE. CM1054.2 014700 02 FILLER PICTURE X(58) VALUE CM1054.2 014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1054.2 014900 02 FILLER PICTURE X(13) VALUE SPACE. CM1054.2 015000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1054.2 015100 01 CCVS-E-4. CM1054.2 015200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1054.2 015300 02 FILLER PIC XXXX VALUE " OF ". CM1054.2 015400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1054.2 015500 02 FILLER PIC X(40) VALUE CM1054.2 015600 " TESTS WERE EXECUTED SUCCESSFULLY". CM1054.2 015700 01 XXINFO. CM1054.2 015800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1054.2 015900 02 INFO-TEXT. CM1054.2 016000 04 FILLER PIC X(20) VALUE SPACE. CM1054.2 016100 04 XXCOMPUTED PIC X(20). CM1054.2 016200 04 FILLER PIC X(5) VALUE SPACE. CM1054.2 016300 04 XXCORRECT PIC X(20). CM1054.2 016400 01 HYPHEN-LINE. CM1054.2 016500 02 FILLER PICTURE IS X VALUE IS SPACE. CM1054.2 016600 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1054.2 016700- "*****************************************". CM1054.2 016800 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1054.2 016900- "******************************". CM1054.2 017000 01 CCVS-PGM-ID PIC X(6) VALUE CM1054.2 017100 "CM105M". CM1054.2 017200 01 MAIN-QUEUE-NAME. CM1054.2 017300 02 MAIN-QUEUE PIC X(12). CM1054.2 017400 02 FILLER PIC X(36) VALUE SPACE. CM1054.2 017500 COMMUNICATION SECTION. CM1054.2 017600 CD CM-INQUE-1 INPUT STATUS KEY IS IN-STAT SUB-QUEUE-3 CM1054.2 017700 IS-OF-NO-INTEREST COUNT NAMED-BELOW SOURCE NOT-USED. CM1054.2 017800 01 INQUE-RECORD. CM1054.2 017900 02 QUEUE-SET PIC X(48). CM1054.2 018000 02 FILLER PIC X(33). CM1054.2 018100 02 MSG-COUNT-N PIC 9(6). CM1054.2 018200 02 MSG-CNT REDEFINES MSG-COUNT-N. CM1054.2 018300 03 FILLER PIC X(4). CM1054.2 018400 03 MSG-COUNT PIC XX. CM1054.2 018500 PROCEDURE DIVISION. CM1054.2 018600 SECT-CM105M-0001 SECTION. CM1054.2 018700 CM105M-INIT. CM1054.2 018800 OPEN OUTPUT PRINT-FILE. CM1054.2 018900 MOVE "CM105M " TO TEST-ID. CM1054.2 019000 MOVE TEST-ID TO ID-AGAIN. CM1054.2 019100 MOVE SPACE TO TEST-RESULTS. CM1054.2 019200 PERFORM HEAD-ROUTINE. CM1054.2 019300 PERFORM COLUMN-NAMES-ROUTINE. CM1054.2 019400 MOVE CM1054.2 019500 XXXXX030 CM1054.2 019600 TO MAIN-QUEUE. CM1054.2 019700 MOVE MAIN-QUEUE-NAME TO QUEUE-SET. CM1054.2 019800 ENABLE INPUT CM-INQUE-1 KEY CM1054.2 019900 XXXXX031. CM1054.2 020000 PERFORM BUILD-UP-QUEUES VARYING I1 FROM 1 BY 1 CM1054.2 020100 UNTIL I1 IS GREATER THAN 4. CM1054.2 020200 GO TO BEGIN-TESTS. CM1054.2 020300 BUILD-UP-QUEUES. CM1054.2 020400 MOVE NAME-SET (I1) TO QUEUE-SET. CM1054.2 020500 ACCEPT CM-INQUE-1 COUNT. CM1054.2 020600 IF MSG-COUNT IS LESS THAN 10 GO TO BUILD-UP-QUEUES. CM1054.2 020700 BEGIN-TESTS. CM1054.2 020800 DISABLE INPUT CM-INQUE-1 KEY CM1054.2 020900 XXXXX031. CM1054.2 021000 MOVE PPPP TO P PP PPP. CM1054.2 021100 MOVE PPSP TO PPS. CM1054.2 021200 MOVE PSPP TO PS PSP. CM1054.2 021300 QUEUE-TEST-01. CM1054.2 021400 MOVE "QUEUE SERIES PPPP" TO FEATURE. CM1054.2 021500 MOVE PPPP TO QUEUE-SET. CM1054.2 021600 PERFORM RECEIVE-A-MSG. CM1054.2 021700 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 021800 PERFORM PASS GO TO QUEUE-TEST-WRITE-01. CM1054.2 021900 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 022000 PERFORM FAIL. CM1054.2 022100 QUEUE-TEST-WRITE-01. CM1054.2 022200 MOVE "QUEUE-TEST-01" TO PAR-NAME. CM1054.2 022300 PERFORM PRINT-DETAIL. CM1054.2 022400 QUEUE-TEST-02. CM1054.2 022500 MOVE "QUEUE SERIES PPPS" TO FEATURE. CM1054.2 022600 MOVE PPPS TO QUEUE-SET. CM1054.2 022700 PERFORM RECEIVE-A-MSG. CM1054.2 022800 IF QUEUE-KEY IS EQUAL TO "PPPS" CM1054.2 022900 PERFORM PASS GO TO QUEUE-TEST-WRITE-02. CM1054.2 023000 MOVE "PPPS" TO CORRECT-QUEUE. CM1054.2 023100 PERFORM FAIL. CM1054.2 023200 QUEUE-TEST-WRITE-02. CM1054.2 023300 MOVE "QUEUE-TEST-02" TO PAR-NAME. CM1054.2 023400 PERFORM PRINT-DETAIL. CM1054.2 023500 QUEUE-TEST-03. CM1054.2 023600 MOVE "QUEUE SERIES PPSP" TO FEATURE. CM1054.2 023700 MOVE PPSP TO QUEUE-SET. CM1054.2 023800 PERFORM RECEIVE-A-MSG. CM1054.2 023900 IF QUEUE-KEY IS EQUAL TO "PPSP" CM1054.2 024000 PERFORM PASS GO TO QUEUE-TEST-WRITE-03. CM1054.2 024100 MOVE "PPSP" TO CORRECT-QUEUE. CM1054.2 024200 PERFORM FAIL. CM1054.2 024300 QUEUE-TEST-WRITE-03. CM1054.2 024400 MOVE "QUEUE-TEST-03" TO PAR-NAME. CM1054.2 024500 PERFORM PRINT-DETAIL. CM1054.2 024600 QUEUE-TEST-04. CM1054.2 024700 MOVE "QUEUE SERIES PSPP" TO FEATURE. CM1054.2 024800 MOVE PSPP TO QUEUE-SET. CM1054.2 024900 PERFORM RECEIVE-A-MSG. CM1054.2 025000 IF QUEUE-KEY IS EQUAL TO "PSPP" CM1054.2 025100 PERFORM PASS GO TO QUEUE-TEST-WRITE-04. CM1054.2 025200 MOVE "PSPP" TO CORRECT-QUEUE. CM1054.2 025300 PERFORM FAIL. CM1054.2 025400 QUEUE-TEST-WRITE-04. CM1054.2 025500 MOVE "QUEUE-TEST-04" TO PAR-NAME. CM1054.2 025600 PERFORM PRINT-DETAIL. CM1054.2 025700 QUEUE-TEST-05. CM1054.2 025800 MOVE "QUEUE SERIES P" TO FEATURE. CM1054.2 025900 MOVE P TO QUEUE-SET. CM1054.2 026000 PERFORM RECEIVE-A-MSG. CM1054.2 026100 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 026200 PERFORM PASS GO TO QUEUE-TEST-WRITE-05. CM1054.2 026300 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 026400 PERFORM FAIL. CM1054.2 026500 QUEUE-TEST-WRITE-05. CM1054.2 026600 MOVE "QUEUE-TEST-05" TO PAR-NAME. CM1054.2 026700 PERFORM PRINT-DETAIL. CM1054.2 026800 QUEUE-TEST-06. CM1054.2 026900 MOVE "QUEUE SERIES PP" TO FEATURE. CM1054.2 027000 MOVE PP TO QUEUE-SET. CM1054.2 027100 PERFORM RECEIVE-A-MSG. CM1054.2 027200 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 027300 PERFORM PASS GO TO QUEUE-TEST-WRITE-06. CM1054.2 027400 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 027500 PERFORM FAIL. CM1054.2 027600 QUEUE-TEST-WRITE-06. CM1054.2 027700 MOVE "QUEUE-TEST-06" TO PAR-NAME. CM1054.2 027800 PERFORM PRINT-DETAIL. CM1054.2 027900 QUEUE-TEST-07. CM1054.2 028000 MOVE "QUEUE SERIES PPP" TO FEATURE. CM1054.2 028100 MOVE PPP TO QUEUE-SET. CM1054.2 028200 PERFORM RECEIVE-A-MSG. CM1054.2 028300 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 028400 PERFORM PASS GO TO QUEUE-TEST-WRITE-07. CM1054.2 028500 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 028600 PERFORM FAIL. CM1054.2 028700 QUEUE-TEST-WRITE-07. CM1054.2 028800 MOVE "QUEUE-TEST-07" TO PAR-NAME. CM1054.2 028900 PERFORM PRINT-DETAIL. CM1054.2 029000 QUEUE-TEST-08. CM1054.2 029100 MOVE "QUEUE SERIES PS" TO FEATURE. CM1054.2 029200 MOVE PS TO QUEUE-SET. CM1054.2 029300 PERFORM RECEIVE-A-MSG. CM1054.2 029400 IF QUEUE-KEY IS EQUAL TO "PSPP" CM1054.2 029500 PERFORM PASS GO TO QUEUE-TEST-WRITE-08. CM1054.2 029600 MOVE "PSPP" TO CORRECT-QUEUE. CM1054.2 029700 PERFORM FAIL. CM1054.2 029800 QUEUE-TEST-WRITE-08. CM1054.2 029900 MOVE "QUEUE-TEST-08" TO PAR-NAME. CM1054.2 030000 PERFORM PRINT-DETAIL. CM1054.2 030100 QUEUE-TEST-09. CM1054.2 030200 MOVE "QUEUE SERIES PSP" TO FEATURE. CM1054.2 030300 MOVE PSP TO QUEUE-SET. CM1054.2 030400 PERFORM RECEIVE-A-MSG. CM1054.2 030500 IF QUEUE-KEY IS EQUAL TO "PSPP" CM1054.2 030600 PERFORM PASS GO TO QUEUE-TEST-WRITE-09. CM1054.2 030700 MOVE "PSPP" TO CORRECT-QUEUE. CM1054.2 030800 PERFORM FAIL. CM1054.2 030900 QUEUE-TEST-WRITE-09. CM1054.2 031000 MOVE "QUEUE-TEST-09" TO PAR-NAME. CM1054.2 031100 PERFORM PRINT-DETAIL. CM1054.2 031200 QUEUE-TEST-10. CM1054.2 031300 MOVE "QUEUE SERIES PPS" TO FEATURE. CM1054.2 031400 MOVE PPS TO QUEUE-SET. CM1054.2 031500 PERFORM RECEIVE-A-MSG. CM1054.2 031600 IF QUEUE-KEY IS EQUAL TO "PPSP" CM1054.2 031700 PERFORM PASS GO TO QUEUE-TEST-WRITE-10. CM1054.2 031800 MOVE "PPSP" TO CORRECT-QUEUE. CM1054.2 031900 PERFORM FAIL. CM1054.2 032000 QUEUE-TEST-WRITE-10. CM1054.2 032100 MOVE "QUEUE-TEST-10" TO PAR-NAME. CM1054.2 032200 PERFORM PRINT-DETAIL. CM1054.2 032300 ACCEPT-TEST-01. CM1054.2 032400 MOVE "ACCEPT GROUP QUEUE" TO FEATURE. CM1054.2 032500 MOVE PPPP TO QUEUE-SET. CM1054.2 032600 ACCEPT CM-INQUE-1 COUNT. CM1054.2 032700 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 032800 MOVE IN-STAT TO STAT CM1054.2 032900 MOVE "BAD STATUS FOR PPPP" TO RE-MARK CM1054.2 033000 ELSE CM1054.2 033100 MOVE MSG-COUNT TO STAT CM1054.2 033200 MOVE "COUNT FOR PPPP" TO RE-MARK. CM1054.2 033300 PERFORM ACCEPT-WRITE-01. CM1054.2 033400 MOVE PPPS TO QUEUE-SET. CM1054.2 033500 ACCEPT CM-INQUE-1 COUNT. CM1054.2 033600 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 033700 MOVE IN-STAT TO STAT CM1054.2 033800 MOVE "BAD STATUS FOR PPPS" TO RE-MARK CM1054.2 033900 ELSE CM1054.2 034000 MOVE MSG-COUNT TO STAT CM1054.2 034100 MOVE "COUNT FOR PPPS" TO RE-MARK. CM1054.2 034200 PERFORM ACCEPT-WRITE-01. CM1054.2 034300 MOVE PPSP TO QUEUE-SET. CM1054.2 034400 ACCEPT CM-INQUE-1 COUNT. CM1054.2 034500 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 034600 MOVE IN-STAT TO STAT CM1054.2 034700 MOVE "BAD STATUS FOR PPSP" TO RE-MARK CM1054.2 034800 ELSE CM1054.2 034900 MOVE MSG-COUNT TO STAT CM1054.2 035000 MOVE "COUNT FOR PPSP" TO RE-MARK. CM1054.2 035100 PERFORM ACCEPT-WRITE-01. CM1054.2 035200 MOVE PSPP TO QUEUE-SET. CM1054.2 035300 ACCEPT CM-INQUE-1 COUNT. CM1054.2 035400 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 035500 MOVE IN-STAT TO STAT CM1054.2 035600 MOVE "BAD STATUS FOR PSPP" TO RE-MARK CM1054.2 035700 ELSE CM1054.2 035800 MOVE MSG-COUNT TO STAT CM1054.2 035900 MOVE "COUNT FOR PSPP" TO RE-MARK. CM1054.2 036000 PERFORM ACCEPT-WRITE-01. CM1054.2 036100 MOVE P TO QUEUE-SET. CM1054.2 036200 ACCEPT CM-INQUE-1 COUNT. CM1054.2 036300 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 036400 MOVE IN-STAT TO STAT CM1054.2 036500 MOVE "BAD STATUS FOR P" TO RE-MARK CM1054.2 036600 ELSE CM1054.2 036700 MOVE MSG-COUNT TO STAT CM1054.2 036800 MOVE "COUNT FOR P" TO RE-MARK. CM1054.2 036900 PERFORM ACCEPT-WRITE-01. CM1054.2 037000 MOVE PP TO QUEUE-SET. CM1054.2 037100 ACCEPT CM-INQUE-1 COUNT. CM1054.2 037200 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 037300 MOVE IN-STAT TO STAT CM1054.2 037400 MOVE "BAD STATUS FOR PP" TO STAT CM1054.2 037500 ELSE CM1054.2 037600 MOVE MSG-COUNT TO STAT CM1054.2 037700 MOVE "COUNT FOR PP" TO RE-MARK. CM1054.2 037800 PERFORM ACCEPT-WRITE-01. CM1054.2 037900 MOVE PPP TO QUEUE-SET. CM1054.2 038000 ACCEPT CM-INQUE-1 COUNT. CM1054.2 038100 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 038200 MOVE IN-STAT TO STAT CM1054.2 038300 MOVE "BAD STATUS FOR PPP" TO STAT CM1054.2 038400 ELSE CM1054.2 038500 MOVE MSG-COUNT TO STAT CM1054.2 038600 MOVE "COUNT FOR PPP" TO RE-MARK. CM1054.2 038700 PERFORM ACCEPT-WRITE-01. CM1054.2 038800 MOVE PS TO QUEUE-SET. CM1054.2 038900 ACCEPT CM-INQUE-1 COUNT. CM1054.2 039000 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 039100 MOVE IN-STAT TO STAT CM1054.2 039200 MOVE "BAD STATUS FOR PS" TO STAT CM1054.2 039300 ELSE CM1054.2 039400 MOVE MSG-COUNT TO STAT CM1054.2 039500 MOVE "COUNT FOR PS" TO RE-MARK. CM1054.2 039600 PERFORM ACCEPT-WRITE-01. CM1054.2 039700 MOVE PSP TO QUEUE-SET. CM1054.2 039800 ACCEPT CM-INQUE-1 COUNT. CM1054.2 039900 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 040000 MOVE IN-STAT TO STAT CM1054.2 040100 MOVE "BAD STATUS FOR PSP" TO STAT CM1054.2 040200 ELSE CM1054.2 040300 MOVE MSG-COUNT TO STAT CM1054.2 040400 MOVE "COUNT FOR PSP" TO RE-MARK. CM1054.2 040500 PERFORM ACCEPT-WRITE-01. CM1054.2 040600 MOVE PPS TO QUEUE-SET. CM1054.2 040700 ACCEPT CM-INQUE-1 COUNT. CM1054.2 040800 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 040900 MOVE IN-STAT TO STAT CM1054.2 041000 MOVE "BAD STATUS FOR PPS" TO STAT CM1054.2 041100 ELSE CM1054.2 041200 MOVE MSG-COUNT TO STAT CM1054.2 041300 MOVE "COUNT FOR PPS" TO RE-MARK. CM1054.2 041400 PERFORM ACCEPT-WRITE-01. CM1054.2 041500 GO TO CM105-FINI. CM1054.2 041600 ACCEPT-WRITE-01. CM1054.2 041700 MOVE "ACCEPT-TEST-01" TO PAR-NAME. CM1054.2 041800 MOVE "INFO" TO P-OR-F. CM1054.2 041900 PERFORM PRINT-DETAIL. CM1054.2 042000 CM105-FINI. CM1054.2 042100 PERFORM END-ROUTINE THRU END-ROUTINE-4. CM1054.2 042200 CLOSE PRINT-FILE. CM1054.2 042300 STOP RUN. CM1054.2 042400 RECEIVE-A-MSG. CM1054.2 042500 MOVE SPACE TO RE-MARK. CM1054.2 042600 RECEIVE CM-INQUE-1 MESSAGE INTO RE-MARK CM1054.2 042700 NO DATA MOVE "NOTHING RECEIVED FROM MCS" TO RE-MARK. CM1054.2 042800 COMMON-SUBROUTINES SECTION. CM1054.2 042900 PASS. CM1054.2 043000 MOVE "PASS" TO P-OR-F. CM1054.2 043100 FAIL. CM1054.2 043200 MOVE " SEE REMARKS COLUMN " TO COMPUTED-A. CM1054.2 043300 ADD 1 TO ERROR-COUNTER. CM1054.2 043400 MOVE "FAIL*" TO P-OR-F. CM1054.2 043500 PRINT-DETAIL. CM1054.2 043600 MOVE TEST-RESULTS TO PRINT-REC. CM1054.2 043700 PERFORM WRITE-LINE. CM1054.2 043800 MOVE SPACE TO P-OR-F. CM1054.2 043900 MOVE SPACE TO COMPUTED-A. CM1054.2 044000 MOVE SPACE TO CORRECT-A. CM1054.2 044100 MOVE SPACE TO RE-MARK. CM1054.2 044200 COLUMN-NAMES-ROUTINE. CM1054.2 044300 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. CM1054.2 044400 PERFORM WRITE-LINE. CM1054.2 044500 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. CM1054.2 044600 PERFORM WRITE-LINE. CM1054.2 044700 PERFORM BLANK-LINE-PRINT. CM1054.2 044800 END-ROUTINE. CM1054.2 044900 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1054.2 045000 PERFORM WRITE-LINE. CM1054.2 045100 PARA-Z. CM1054.2 045200 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1054.2 045300 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1054.2 045400 PERFORM WRITE-LINE. CM1054.2 045500 END-ROUTINE-1. CM1054.2 045600 PERFORM BLANK-LINE-PRINT. CM1054.2 045700 IF ERROR-COUNTER IS EQUAL TO ZERO CM1054.2 045800 GO TO END-ROUTINE-2. CM1054.2 045900 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM1054.2 046000 GO TO END-ROUTINE-3. CM1054.2 046100 END-ROUTINE-2. CM1054.2 046200 MOVE " NO" TO ERROR-TOTAL. CM1054.2 046300 END-ROUTINE-3. CM1054.2 046400 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1054.2 046500 PERFORM WRITE-LINE. CM1054.2 046600 IF DELETE-CNT IS EQUAL TO ZERO CM1054.2 046700 MOVE " NO" TO ERROR-TOTAL ELSE CM1054.2 046800 MOVE DELETE-CNT TO ERROR-TOTAL. CM1054.2 046900 MOVE "TESTS DELETED " TO ENDER-DESC. CM1054.2 047000 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1054.2 047100 PERFORM WRITE-LINE. CM1054.2 047200 END-ROUTINE-4. CM1054.2 047300 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1054.2 047400 PERFORM WRITE-LINE. CM1054.2 047500 BLANK-LINE-PRINT. CM1054.2 047600 MOVE SPACE TO DUMMY-RECORD. CM1054.2 047700 PERFORM WRITE-LINE. CM1054.2 047800 WRITE-LINE. CM1054.2 047900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1054.2 048000 HEAD-ROUTINE. CM1054.2 048100 MOVE CCVS-H-1 TO PRINT-REC CM1054.2 048200 WRITE PRINT-REC CM1054.2 048300 AFTER ADVANCING PAGE. CM1054.2 048400 MOVE CCVS-H-2 TO PRINT-REC. CM1054.2 048500 WRITE PRINT-REC CM1054.2 048600 AFTER 2 LINES. CM1054.2 048700 MOVE CCVS-H-3 TO PRINT-REC. CM1054.2 048800 WRITE PRINT-REC CM1054.2 048900 AFTER 5 LINES. CM1054.2 049000 MOVE HYPHEN-LINE TO PRINT-REC. CM1054.2 049100 PERFORM WRITE-LINE. CM1054.2 *END-OF,CM105M *HEADER,COBOL,CM201M 000100 IDENTIFICATION DIVISION. CM2014.2 000200 PROGRAM-ID. CM2014.2 000300 CM201M. CM2014.2 000400 AUTHOR. CM2014.2 000500 FEDERAL COMPILER TESTING CENTER. CM2014.2 000600 INSTALLATION. CM2014.2 000700 GENERAL SERVICES ADMINISTRATION CM2014.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM2014.2 000900 SOFTWARE DEVELOPMENT OFFICE. CM2014.2 001000 5203 LEESBURG PIKE SUITE 1100 CM2014.2 001100 FALLS CHURCH VIRGINIA 22041. CM2014.2 001200 CM2014.2 001300 PHONE (703) 756-6153 CM2014.2 001400 CM2014.2 001500 " HIGH ". CM2014.2 001600 DATE-WRITTEN. CM2014.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM2014.2 001800 CREATION DATE / VALIDATION DATE CM2014.2 001900 "4.2 ". CM2014.2 002000 SECURITY. CM2014.2 002100 NONE. CM2014.2 002200 ENVIRONMENT DIVISION. CM2014.2 002300 CONFIGURATION SECTION. CM2014.2 002400 SOURCE-COMPUTER. CM2014.2 002500 XXXXX082. CM2014.2 002600 OBJECT-COMPUTER. CM2014.2 002700 XXXXX083. CM2014.2 002800 DATA DIVISION. CM2014.2 002900 WORKING-STORAGE SECTION. CM2014.2 003000 77 MSG-72 PIC X(72). CM2014.2 003100 01 RECOGNITION-MSG-1. CM2014.2 003200 02 FILLER PIC X(32) VALUE CM2014.2 003300 "RECEIPT OF MESSAGE FROM DEVICE """. CM2014.2 003400 02 DEVICE-NAME PIC X(12). CM2014.2 003500 02 FILLER PIC X(18) VALUE CM2014.2 003600 """ IS ACKNOWLEDGED.". CM2014.2 003700 01 RECOGNITION-MSG-2. CM2014.2 003800 02 FILLER PIC X(20) VALUE CM2014.2 003900 "QUEUE INVOLVED WAS """. CM2014.2 004000 02 QUEUE-INVOLVED PIC X(48). CM2014.2 004100 02 FILLER PIC XX VALUE """.". CM2014.2 004200 01 RECOGNITION-MSG-3 PIC X(41) VALUE CM2014.2 004300 "CM201M INVOKED BUT NO DATA WAS AVAILABLE.". CM2014.2 004400 COMMUNICATION SECTION. CM2014.2 004500 CD CM-INQUE-1 FOR INITIAL INPUT. CM2014.2 004600 01 INQUE-1-RECORD. CM2014.2 004700 02 QUEUE-SET PIC X(48). CM2014.2 004800 02 FILLER PIC X(14). CM2014.2 004900 02 SYM-SOURCE PIC X(12). CM2014.2 005000 02 IN-LENGTH PIC 9(4). CM2014.2 005100 02 FILLER PIC XXX. CM2014.2 005200 02 MSG-COUNT PIC 9(6). CM2014.2 005300 CD CM-OUTQUE-1 FOR OUTPUT. CM2014.2 005400 01 OUTQUE-1-RECORD. CM2014.2 005500 02 FILLER PIC 9999 VALUE 1. CM2014.2 005600 02 OUT-LENGTH PIC 9999. CM2014.2 005700 02 FILLER PIC XXX. CM2014.2 005800 02 SYM-DEST PIC X(12) VALUE CM2014.2 005900 XXXXX032. CM2014.2 006000 PROCEDURE DIVISION. CM2014.2 006100 SECT-CM201M-0001 SECTION. CM2014.2 006200 CM201M-INIT. CM2014.2 006300 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM2014.2 006400 XXXXX033. CM2014.2 006500 TAKE-NEXT-MSG. CM2014.2 006600 RECEIVE CM-INQUE-1 MESSAGE INTO MSG-72 CM2014.2 006700 NO DATA GO TO SOMETHING-IS-WRONG-HERE. CM2014.2 006800 MOVE QUEUE-SET TO QUEUE-INVOLVED. CM2014.2 006900 MOVE SYM-SOURCE TO DEVICE-NAME. CM2014.2 007000 MOVE 62 TO OUT-LENGTH. CM2014.2 007100 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-1 WITH EMI. CM2014.2 007200 MOVE 70 TO OUT-LENGTH. CM2014.2 007300 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-2 WITH EMI. CM2014.2 007400 MOVE IN-LENGTH TO OUT-LENGTH. CM2014.2 007500 SEND CM-OUTQUE-1 FROM MSG-72 WITH EGI. CM2014.2 007600 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM2014.2 007700 IF MSG-COUNT IS EQUAL TO 0 STOP RUN CM2014.2 007800 ELSE GO TO TAKE-NEXT-MSG. CM2014.2 007900 SOMETHING-IS-WRONG-HERE. CM2014.2 008000 MOVE 40 TO OUT-LENGTH. CM2014.2 008100 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-3 WITH EMI. CM2014.2 008200 MOVE QUEUE-SET TO QUEUE-INVOLVED. CM2014.2 008300 MOVE 70 TO OUT-LENGTH. CM2014.2 008400 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-2 WITH EGI. CM2014.2 008500 STOP RUN. CM2014.2 *END-OF,CM201M *HEADER,COBOL,CM202M 000100 IDENTIFICATION DIVISION. CM2024.2 000200 PROGRAM-ID. CM2024.2 000300 CM202M. CM2024.2 000400 AUTHOR. CM2024.2 000500 FEDERAL COMPILER TESTING CENTER. CM2024.2 000600 INSTALLATION. CM2024.2 000700 GENERAL SERVICES ADMINISTRATION CM2024.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM2024.2 000900 SOFTWARE DEVELOPMENT OFFICE. CM2024.2 001000 5203 LEESBURG PIKE SUITE 1100 CM2024.2 001100 FALLS CHURCH VIRGINIA 22041. CM2024.2 001200 CM2024.2 001300 PHONE (703) 756-6153 CM2024.2 001400 CM2024.2 001500 " HIGH ". CM2024.2 001600 DATE-WRITTEN. CM2024.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM2024.2 001800 CREATION DATE / VALIDATION DATE CM2024.2 001900 "4.2 ". CM2024.2 002000 SECURITY. CM2024.2 002100 NONE. CM2024.2 002200 ENVIRONMENT DIVISION. CM2024.2 002300 CONFIGURATION SECTION. CM2024.2 002400 SOURCE-COMPUTER. CM2024.2 002500 XXXXX082. CM2024.2 002600 OBJECT-COMPUTER. CM2024.2 002700 XXXXX083. CM2024.2 002800 INPUT-OUTPUT SECTION. CM2024.2 002900 FILE-CONTROL. CM2024.2 003000 SELECT PRINT-FILE ASSIGN TO CM2024.2 003100 XXXXX055. CM2024.2 003200 DATA DIVISION. CM2024.2 003300 FILE SECTION. CM2024.2 003400 FD PRINT-FILE CM2024.2 003500 LABEL RECORDS CM2024.2 003600 XXXXX084 CM2024.2 003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM2024.2 003800 01 PRINT-REC PICTURE X(120). CM2024.2 003900 01 DUMMY-RECORD PICTURE X(120). CM2024.2 004000 WORKING-STORAGE SECTION. CM2024.2 004100 77 END-FLAG PIC 9. CM2024.2 004200 77 FAIL-SAFE PIC 999 COMP. CM2024.2 004300 77 ELAPSED-TIME PIC 999. CM2024.2 004400 77 ENABLE-ALL-MSG PIC X(57) VALUE CM2024.2 004500 "ATTEMPT TO ENTER MESSAGES. BOTH SOURCES ARE NOW ENABLED.". CM2024.2 004600 01 INIT-TIME. CM2024.2 004700 02 I-HRS PIC 99. CM2024.2 004800 02 I-MINS PIC 99. CM2024.2 004900 02 I-SECS PIC 99V99. CM2024.2 005000 01 TEST-TIME. CM2024.2 005100 02 T-HRS PIC 99. CM2024.2 005200 02 T-MINS PIC 99. CM2024.2 005300 02 T-SECS PIC 99V99. CM2024.2 005400 01 SKIP-MSG-1 PIC X(71) VALUE "SEGMENTED-MSG-TEST-05: THERE SHOUCM2024.2 005500- "LD BE NO BLANK LINES BETWEEN THIS LINE". CM2024.2 005600 01 SKIP-MSG-2 PIC X(17) VALUE "AND THIS ONE.". CM2024.2 005700 01 INCOMP-MSG. CM2024.2 005800 02 FILLER PIC X(20) VALUE "INCOMPLETE-MSG-TEST-". CM2024.2 005900 02 INC-MSG-NO PIC 99. CM2024.2 006000 02 FILLER PIC X(33) VALUE " FAILURE IF THIS SEGMENT APPEARS.CM2024.2 006100- "". CM2024.2 006200 01 ENABLE-MSG. CM2024.2 006300 02 FILLER PIC X(34) VALUE "ATTEMPT TO ENTER MESSAGES. ONLY CM2024.2 006400- """". CM2024.2 006500 02 SELECTED-SOURCE PIC X(12). CM2024.2 006600 02 FILLER PIC X(13) VALUE """ IS ENABLED.". CM2024.2 006700 01 DISABLE-MSG. CM2024.2 006800 02 FILLER PIC X(36) VALUE CM2024.2 006900 "TERMINALS DEACTIVATED FOR INPUT: ". CM2024.2 007000 02 TERMINAL-1 PIC X(14) VALUE CM2024.2 007100 XXXXX042. CM2024.2 007200 02 TERMINAL-2 PIC X(12) VALUE CM2024.2 007300 XXXXX043. CM2024.2 007400 01 SEND-MSG. CM2024.2 007500 02 FILLER PIC X(17) VALUE "SEND-STATUS-TEST-". CM2024.2 007600 02 TEST-NUMB PIC 99 VALUE 1. CM2024.2 007700 02 FILLER PIC X(42) VALUE CM2024.2 007800 " FAILURE. THIS MESSAGE SHOULD NOT APPEAR.". CM2024.2 007900 01 ONE-TERMINAL-MSG. CM2024.2 008000 02 FILLER PIC X(15) VALUE "ONLY TERMINAL """. CM2024.2 008100 02 SELECTED-DEST PIC X(12) VALUE CM2024.2 008200 XXXXX032. CM2024.2 008300 02 FILLER PIC X(30) VALUE CM2024.2 008400 """ SHOULD RECEIVE THIS MESSAGE.". CM2024.2 008500 01 SEG-INIT. CM2024.2 008600 02 FILLER PIC X(19) VALUE "SEGMENTED-MSG-TEST-". CM2024.2 008700 02 SEG-TEST-NO PIC 99. CM2024.2 008800 02 FILLER PIC X(19) VALUE " SEGMENT INITIATED ". CM2024.2 008900 02 FILLER PIC X(16) VALUE "-LENGTH FAILURE ". CM2024.2 009000 01 SEG-CONT PIC X(10) VALUE "-CONTINUED". CM2024.2 009100 01 MSG-COMP PIC X(14) VALUE "-MSG COMPLETE.". CM2024.2 009200 01 GROUP-COMP PIC X(16) VALUE "-GROUP COMPLETE.". CM2024.2 009300 01 TEST-RESULTS. CM2024.2 009400 02 FILLER PICTURE X VALUE SPACE. CM2024.2 009500 02 FEATURE PICTURE X(18). CM2024.2 009600 02 FILLER PICTURE X VALUE SPACE. CM2024.2 009700 02 P-OR-F PICTURE X(5). CM2024.2 009800 02 FILLER PICTURE X VALUE SPACE. CM2024.2 009900 02 PAR-NAME PIC X(20). CM2024.2 010000 02 FILLER PICTURE X VALUE SPACE. CM2024.2 010100 02 COMPUTED-A. CM2024.2 010200 03 FILLER PIC X(9). CM2024.2 010300 03 COMPUTED-STATUS PIC XX. CM2024.2 010400 03 FILLER PIC X(9). CM2024.2 010500 02 FILLER PICTURE X VALUE SPACE. CM2024.2 010600 02 CORRECT-A. CM2024.2 010700 03 FILLER PIC X(9). CM2024.2 010800 03 CORRECT-STATUS PIC XX. CM2024.2 010900 03 FILLER PIC X(9). CM2024.2 011000 02 FILLER PICTURE X VALUE SPACE. CM2024.2 011100 02 RE-MARK. CM2024.2 011200 03 MSG-1 PIC X. CM2024.2 011300 03 FILLER PIC X(29). CM2024.2 011400 01 COLUMNS-LINE-1. CM2024.2 011500 02 FILLER PIC X(3) VALUE SPACES. CM2024.2 011600 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM2024.2 011700 02 FILLER PIC X(9) VALUE "RESLT". CM2024.2 011800 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM2024.2 011900 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM2024.2 012000 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM2024.2 012100 02 FILLER PIC X(7) VALUE "REMARKS". CM2024.2 012200 01 COLUMNS-LINE-2. CM2024.2 012300 02 FILLER PIC X VALUE SPACE. CM2024.2 012400 02 FILLER PIC X(18) VALUE ALL "-". CM2024.2 012500 02 FILLER PIC X VALUE SPACE. CM2024.2 012600 02 FILLER PIC X(5) VALUE ALL "-". CM2024.2 012700 02 FILLER PIC X VALUE SPACE. CM2024.2 012800 02 FILLER PIC X(20) VALUE ALL "-". CM2024.2 012900 02 FILLER PIC X VALUE SPACE. CM2024.2 013000 02 FILLER PIC X(20) VALUE ALL "-". CM2024.2 013100 02 FILLER PIC X VALUE SPACE. CM2024.2 013200 02 FILLER PIC X(20) VALUE ALL "-". CM2024.2 013300 02 FILLER PIC X VALUE SPACE. CM2024.2 013400 02 FILLER PIC X(31) VALUE ALL "-". CM2024.2 013500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM2024.2 013600 01 REC-CT PICTURE 99 VALUE ZERO. CM2024.2 013700 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM2024.2 013800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM2024.2 013900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM2024.2 014000 01 PASS-COUNTER PIC 999 VALUE ZERO. CM2024.2 014100 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM2024.2 014200 01 ERROR-HOLD PIC 999 VALUE ZERO. CM2024.2 014300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM2024.2 014400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM2024.2 014500 01 CCVS-H-1. CM2024.2 014600 02 FILLER PICTURE X(27) VALUE SPACE. CM2024.2 014700 02 FILLER PICTURE X(67) VALUE CM2024.2 014800 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM2024.2 014900- " SYSTEM". CM2024.2 015000 02 FILLER PICTURE X(26) VALUE SPACE. CM2024.2 015100 01 CCVS-H-2. CM2024.2 015200 02 FILLER PICTURE X(52) VALUE IS CM2024.2 015300 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM2024.2 015400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM2024.2 015500 02 TEST-ID PICTURE IS X(9). CM2024.2 015600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM2024.2 015700 01 CCVS-H-3. CM2024.2 015800 02 FILLER PICTURE X(34) VALUE CM2024.2 015900 " FOR OFFICIAL USE ONLY ". CM2024.2 016000 02 FILLER PICTURE X(58) VALUE CM2024.2 016100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM2024.2 016200 02 FILLER PICTURE X(28) VALUE CM2024.2 016300 " COPYRIGHT 1974 ". CM2024.2 016400 01 CCVS-E-1. CM2024.2 016500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM2024.2 016600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM2024.2 016700 02 ID-AGAIN PICTURE IS X(9). CM2024.2 016800 02 FILLER PICTURE X(45) VALUE IS CM2024.2 016900 " NTIS DISTRIBUTION COBOL 74". CM2024.2 017000 01 CCVS-E-2. CM2024.2 017100 02 FILLER PICTURE X(31) VALUE CM2024.2 017200 SPACE. CM2024.2 017300 02 FILLER PICTURE X(21) VALUE SPACE. CM2024.2 017400 02 CCVS-E-2-2. CM2024.2 017500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM2024.2 017600 03 FILLER PICTURE IS X VALUE IS SPACE. CM2024.2 017700 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM2024.2 017800 01 CCVS-E-3. CM2024.2 017900 02 FILLER PICTURE X(22) VALUE CM2024.2 018000 " FOR OFFICIAL USE ONLY". CM2024.2 018100 02 FILLER PICTURE X(12) VALUE SPACE. CM2024.2 018200 02 FILLER PICTURE X(58) VALUE CM2024.2 018300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM2024.2 018400 02 FILLER PICTURE X(13) VALUE SPACE. CM2024.2 018500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM2024.2 018600 01 CCVS-E-4. CM2024.2 018700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM2024.2 018800 02 FILLER PIC XXXX VALUE " OF ". CM2024.2 018900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM2024.2 019000 02 FILLER PIC X(40) VALUE CM2024.2 019100 " TESTS WERE EXECUTED SUCCESSFULLY". CM2024.2 019200 01 XXINFO. CM2024.2 019300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM2024.2 019400 02 INFO-TEXT. CM2024.2 019500 04 FILLER PIC X(20) VALUE SPACE. CM2024.2 019600 04 XXCOMPUTED PIC X(20). CM2024.2 019700 04 FILLER PIC X(5) VALUE SPACE. CM2024.2 019800 04 XXCORRECT PIC X(20). CM2024.2 019900 01 HYPHEN-LINE. CM2024.2 020000 02 FILLER PICTURE IS X VALUE IS SPACE. CM2024.2 020100 02 FILLER PICTURE IS X(65) VALUE IS "************************CM2024.2 020200- "*****************************************". CM2024.2 020300 02 FILLER PICTURE IS X(54) VALUE IS "************************CM2024.2 020400- "******************************". CM2024.2 020500 01 CCVS-PGM-ID PIC X(6) VALUE CM2024.2 020600 "CM202M". CM2024.2 020700 COMMUNICATION SECTION. CM2024.2 020800 CD CM-INQUE-1 INPUT. CM2024.2 020900 01 INQUE-1-RECORD. CM2024.2 021000 02 QUEUE-SET PIC X(12) VALUE CM2024.2 021100 XXXXX030. CM2024.2 021200 02 FILLER PIC X(36) VALUE SPACES. CM2024.2 021300 02 FILLER PIC X(14). CM2024.2 021400 02 SYM-SOURCE PIC X(12). CM2024.2 021500 02 IN-LENGTH PIC 9999. CM2024.2 021600 02 END-KEY PIC X. CM2024.2 021700 02 IN-STATUS PIC XX. CM2024.2 021800 02 MSG-COUNT PIC 9(6). CM2024.2 021900 CD CM-OUTQUE-1 OUTPUT CM2024.2 022000 DESTINATION COUNT DEST-COUNT CM2024.2 022100 TEXT LENGTH OUT-LENGTH CM2024.2 022200 STATUS KEY OUT-STATUS CM2024.2 022300 DESTINATION TABLE OCCURS 2 TIMES INDEXED BY I1 CM2024.2 022400 ERROR KEY ERR-KEY CM2024.2 022500 DESTINATION SYM-DEST. CM2024.2 022600 PROCEDURE DIVISION. CM2024.2 022700 SECT-CM202M-0001 SECTION. CM2024.2 022800 CM202M-INIT. CM2024.2 022900 OPEN OUTPUT PRINT-FILE. CM2024.2 023000 MOVE "CM202M " TO TEST-ID. CM2024.2 023100 MOVE TEST-ID TO ID-AGAIN. CM2024.2 023200 MOVE SPACE TO TEST-RESULTS. CM2024.2 023300 PERFORM HEAD-ROUTINE. CM2024.2 023400 MOVE 2 TO DEST-COUNT CM2024.2 023500 MOVE CM2024.2 023600 XXXXX032 CM2024.2 023700 TO SYM-DEST (1). CM2024.2 023800 MOVE CM2024.2 023900 XXXXX035 CM2024.2 024000 TO SYM-DEST (2). CM2024.2 024100 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM2024.2 024200 XXXXX033. CM2024.2 024300 MOVE CM2024.2 024400 XXXXX042 CM2024.2 024500 TO SELECTED-SOURCE SYM-SOURCE. CM2024.2 024600 MOVE 59 TO OUT-LENGTH. CM2024.2 024700 SEND CM-OUTQUE-1 FROM ENABLE-MSG WITH EMI. CM2024.2 024800 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 024900 XXXXX031. CM2024.2 025000 PERFORM DELAY-FOR-30. CM2024.2 025100 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 025200 XXXXX031. CM2024.2 025300 MOVE CM2024.2 025400 XXXXX043 CM2024.2 025500 TO SELECTED-SOURCE SYM-SOURCE. CM2024.2 025600 SEND CM-OUTQUE-1 FROM ENABLE-MSG WITH EMI. CM2024.2 025700 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 025800 XXXXX031. CM2024.2 025900 PERFORM DELAY-FOR-30. CM2024.2 026000 MOVE 57 TO OUT-LENGTH. CM2024.2 026100 SEND CM-OUTQUE-1 FROM ENABLE-ALL-MSG WITH EMI. CM2024.2 026200 MOVE CM2024.2 026300 XXXXX042 CM2024.2 026400 TO SYM-SOURCE. CM2024.2 026500 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 026600 XXXXX031. CM2024.2 026700 PERFORM DELAY-FOR-30. CM2024.2 026800 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 026900 XXXXX031. CM2024.2 027000 MOVE CM2024.2 027100 XXXXX043 CM2024.2 027200 TO SYM-SOURCE. CM2024.2 027300 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 027400 XXXXX031. CM2024.2 027500 MOVE 62 TO OUT-LENGTH. CM2024.2 027600 SEND CM-OUTQUE-1 FROM DISABLE-MSG WITH EMI. CM2024.2 027700 PERFORM DELAY-FOR-30. CM2024.2 027800 BEGIN-CM202M-STATUS-TESTS. CM2024.2 027900 MOVE 200 TO FAIL-SAFE. CM2024.2 028000 MOVE "RCV MSG/SHORT AREA" TO FEATURE. CM2024.2 028100 MOVE "RECEIVE-TEST-01" TO PAR-NAME. CM2024.2 028200 MOVE " SEE REMARKS COLUMN " TO COMPUTED-A. CM2024.2 028300 MOVE " INSPECT RESULTS" TO CORRECT-A. CM2024.2 028400 RECEIVE-TEST-01. CM2024.2 028500 RECEIVE CM-INQUE-1 MESSAGE INTO MSG-1 NO DATA CM2024.2 028600 MOVE "QUEUE TESTED EMPTY" TO COMPUTED-A CM2024.2 028700 MOVE SPACES TO CORRECT-A RE-MARK CM2024.2 028800 PERFORM FAIL PERFORM PRINT-DETAIL CM2024.2 028900 GO TO RECEIVE-TEST-02-INIT. CM2024.2 029000 IF END-KEY IS EQUAL TO "1" CM2024.2 029100 MOVE SPACE TO CORRECT-A CM2024.2 029200 MOVE " ESI WAS SENSED " TO COMPUTED-A CM2024.2 029300 PERFORM FAIL CM2024.2 029400 PERFORM PRINT-DETAIL CM2024.2 029500 GO TO RECEIVE-TEST-02-INIT. CM2024.2 029600 PERFORM PRINT-DETAIL. CM2024.2 029700 IF END-KEY IS NOT EQUAL TO "0" GO TO RECEIVE-TEST-02-INIT. CM2024.2 029800 MOVE "RECEIVE-TEST-01-CONT" TO PAR-NAME. CM2024.2 029900 SUBTRACT 1 FROM FAIL-SAFE. CM2024.2 030000 IF FAIL-SAFE IS EQUAL TO 0 CM2024.2 030100 MOVE "FAIL-SAFE ACTIVATED" TO CORRECT-A CM2024.2 030200 MOVE "****** WARNING *****" TO COMPUTED-A CM2024.2 030300 PERFORM PRINT-DETAIL CM2024.2 030400 GO TO RECEIVE-TEST-02-INIT. CM2024.2 030500 PERFORM PRINT-DETAIL. CM2024.2 030600 GO TO RECEIVE-TEST-01. CM2024.2 030700 RECEIVE-DELETE-01. CM2024.2 030800 PERFORM DE-LETE. CM2024.2 030900 PERFORM PRINT-DETAIL. CM2024.2 031000 RECEIVE-TEST-02-INIT. CM2024.2 031100 MOVE 200 TO FAIL-SAFE. CM2024.2 031200 MOVE "RCV SEG/SHORT AREA" TO FEATURE. CM2024.2 031300 MOVE "RECEIVE-TEST-02" TO PAR-NAME. CM2024.2 031400 MOVE " SEE REMARKS COLUMN " TO COMPUTED-A. CM2024.2 031500 MOVE " INSPECT RESULTS" TO CORRECT-A. CM2024.2 031600 RECEIVE-TEST-02. CM2024.2 031700 RECEIVE CM-INQUE-1 SEGMENT INTO MSG-1 NO DATA CM2024.2 031800 MOVE "QUEUE TESTED EMPTY" TO COMPUTED-A CM2024.2 031900 MOVE SPACES TO CORRECT-A RE-MARK CM2024.2 032000 PERFORM FAIL PERFORM PRINT-DETAIL CM2024.2 032100 GO TO RECEIVE-TEST-03-INIT. CM2024.2 032200 PERFORM PRINT-DETAIL. CM2024.2 032300 IF END-KEY IS NOT EQUAL TO "0" GO TO RECEIVE-TEST-03-INIT. CM2024.2 032400 MOVE "RECEIVE-TEST-02-CONT" TO PAR-NAME. CM2024.2 032500 SUBTRACT 1 FROM FAIL-SAFE. CM2024.2 032600 IF FAIL-SAFE IS EQUAL TO 0 CM2024.2 032700 MOVE "FAIL-SAFE ACTIVATED" TO CORRECT-A CM2024.2 032800 MOVE "****** WARNING *****" TO COMPUTED-A CM2024.2 032900 PERFORM PRINT-DETAIL CM2024.2 033000 GO TO RECEIVE-TEST-03-INIT. CM2024.2 033100 PERFORM PRINT-DETAIL. CM2024.2 033200 GO TO RECEIVE-TEST-02. CM2024.2 033300 RECEIVE-DELETE-02. CM2024.2 033400 PERFORM DE-LETE. CM2024.2 033500 PERFORM PRINT-DETAIL. CM2024.2 033600 RECEIVE-TEST-03-INIT. CM2024.2 033700 MOVE "RCV SEG REPEATEDLY" TO FEATURE. CM2024.2 033800 MOVE "RECEIVE-TEST-03" TO PAR-NAME. CM2024.2 033900 RECEIVE-TEST-03. CM2024.2 034000 MOVE "COMPTD SHOWS END KEY" TO CORRECT-A. CM2024.2 034100 MOVE ALL "*" TO RE-MARK. CM2024.2 034200 RECEIVE CM-INQUE-1 SEGMENT INTO RE-MARK CM2024.2 034300 NO DATA GO TO ENABL-STATUS-TEST-01. CM2024.2 034400 MOVE END-KEY TO COMPUTED-STATUS. CM2024.2 034500 PERFORM PRINT-DETAIL. CM2024.2 034600 MOVE "RECEIVE-TEST-03-CONT" TO PAR-NAME. CM2024.2 034700 GO TO RECEIVE-TEST-03. CM2024.2 034800 RECEIVE-DELETE-03. CM2024.2 034900 PERFORM DE-LETE. CM2024.2 035000 PERFORM PRINT-DETAIL. CM2024.2 035100 ENABL-STATUS-TEST-01. CM2024.2 035200 MOVE "ENABLE TERMINAL" TO FEATURE. CM2024.2 035300 MOVE "BAD PASSWORD SUPPLIED" TO RE-MARK. CM2024.2 035400 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY "GARBAGE". CM2024.2 035500 IF IN-STATUS IS EQUAL TO "40" CM2024.2 035600 PERFORM PASS GO TO ENABL-STATUS-WRITE-01. CM2024.2 035700 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 035800 MOVE "40" TO CORRECT-STATUS. CM2024.2 035900 PERFORM FAIL. CM2024.2 036000 GO TO ENABL-STATUS-WRITE-01. CM2024.2 036100 ENABL-STATUS-DELETE-01. CM2024.2 036200 PERFORM DE-LETE. CM2024.2 036300 ENABL-STATUS-WRITE-01. CM2024.2 036400 MOVE "ENABL-STATUS-TEST-01" TO PAR-NAME. CM2024.2 036500 PERFORM PRINT-DETAIL. CM2024.2 036600 ENABL-STATUS-TEST-02. CM2024.2 036700 MOVE "BAD SOURCE NAME USED" TO RE-MARK. CM2024.2 036800 MOVE "GARBAGE" TO SYM-SOURCE. CM2024.2 036900 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 037000 XXXXX031. CM2024.2 037100 IF IN-STATUS IS EQUAL TO "21" CM2024.2 037200 PERFORM PASS GO TO ENABL-STATUS-WRITE-02. CM2024.2 037300 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 037400 MOVE "21" TO CORRECT-STATUS. CM2024.2 037500 PERFORM FAIL. CM2024.2 037600 GO TO ENABL-STATUS-WRITE-02. CM2024.2 037700 ENABL-STATUS-DELETE-02. CM2024.2 037800 PERFORM DE-LETE. CM2024.2 037900 ENABL-STATUS-WRITE-02. CM2024.2 038000 MOVE "ENABL-STATUS-TEST-02" TO PAR-NAME. CM2024.2 038100 PERFORM PRINT-DETAIL. CM2024.2 038200 DISAB-STATUS-TEST-01. CM2024.2 038300 MOVE "DISABLE TERMINAL" TO FEATURE. CM2024.2 038400 MOVE "BAD PASSWORD SUPPLIED" TO RE-MARK. CM2024.2 038500 MOVE CM2024.2 038600 XXXXX042 CM2024.2 038700 TO SYM-SOURCE. CM2024.2 038800 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY "GARBAGE". CM2024.2 038900 IF IN-STATUS IS EQUAL TO "40" CM2024.2 039000 PERFORM PASS GO TO DISAB-STATUS-WRITE-01. CM2024.2 039100 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 039200 MOVE "40" TO CORRECT-STATUS. CM2024.2 039300 PERFORM FAIL. CM2024.2 039400 GO TO DISAB-STATUS-WRITE-01. CM2024.2 039500 DISAB-STATUS-DELETE-01. CM2024.2 039600 PERFORM DE-LETE. CM2024.2 039700 DISAB-STATUS-WRITE-01. CM2024.2 039800 MOVE "DISAB-STATUS-TEST-01" TO PAR-NAME. CM2024.2 039900 PERFORM PRINT-DETAIL. CM2024.2 040000 DISAB-STATUS-TEST-02. CM2024.2 040100 MOVE "BAD SOURCE NAME USED" TO RE-MARK. CM2024.2 040200 MOVE "GARBAGE" TO SYM-SOURCE. CM2024.2 040300 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 040400 XXXXX031. CM2024.2 040500 IF IN-STATUS IS EQUAL TO "21" CM2024.2 040600 PERFORM PASS GO TO DISAB-STATUS-WRITE-02. CM2024.2 040700 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 040800 MOVE "21" TO CORRECT-STATUS. CM2024.2 040900 PERFORM FAIL. CM2024.2 041000 GO TO DISAB-STATUS-WRITE-02. CM2024.2 041100 DISAB-STATUS-DELETE-02. CM2024.2 041200 PERFORM DE-LETE. CM2024.2 041300 DISAB-STATUS-WRITE-02. CM2024.2 041400 MOVE "DISAB-STATUS-TEST-02" TO PAR-NAME. CM2024.2 041500 PERFORM PRINT-DETAIL. CM2024.2 041600 SEND-STATUS-TEST-01. CM2024.2 041700 MOVE "COUNT EXCEEDS LIMIT" TO RE-MARK. CM2024.2 041800 MOVE 3 TO DEST-COUNT. CM2024.2 041900 MOVE 61 TO OUT-LENGTH. CM2024.2 042000 SEND CM-OUTQUE-1 FROM SEND-MSG WITH EMI. CM2024.2 042100 IF OUT-STATUS IS EQUAL TO "30" CM2024.2 042200 PERFORM PASS GO TO SEND-STATUS-WRITE-01. CM2024.2 042300 MOVE OUT-STATUS TO COMPUTED-STATUS. CM2024.2 042400 MOVE "30" TO CORRECT-STATUS. CM2024.2 042500 PERFORM FAIL. CM2024.2 042600 GO TO SEND-STATUS-WRITE-01. CM2024.2 042700 SEND-STATUS-DELETE-01. CM2024.2 042800 PERFORM DE-LETE. CM2024.2 042900 SEND-STATUS-WRITE-01. CM2024.2 043000 MOVE "DESTINATION COUNT" TO FEATURE. CM2024.2 043100 MOVE "SEND-STATUS-TEST-01" TO PAR-NAME. CM2024.2 043200 PERFORM PRINT-DETAIL. CM2024.2 043300 MOVE 2 TO DEST-COUNT. CM2024.2 043400 SEND-STATUS-TEST-02. CM2024.2 043500 MOVE 2 TO TEST-NUMB. CM2024.2 043600 MOVE 0 TO OUT-LENGTH. CM2024.2 043700 SEND CM-OUTQUE-1 FROM SEND-MSG. CM2024.2 043800 IF OUT-STATUS IS EQUAL TO "60" CM2024.2 043900 PERFORM PASS GO TO SEND-STATUS-WRITE-02. CM2024.2 044000 MOVE OUT-STATUS TO COMPUTED-STATUS. CM2024.2 044100 MOVE "60" TO CORRECT-STATUS. CM2024.2 044200 PERFORM FAIL. CM2024.2 044300 GO TO SEND-STATUS-WRITE-02. CM2024.2 044400 SEND-STATUS-DELETE-02. CM2024.2 044500 PERFORM DE-LETE. CM2024.2 044600 SEND-STATUS-WRITE-02. CM2024.2 044700 MOVE "PARTIAL SEGMENT" TO FEATURE. CM2024.2 044800 MOVE "ZERO CHARACTER COUNT USED" TO RE-MARK. CM2024.2 044900 MOVE "SEND-STATUS-TEST-02" TO PAR-NAME. CM2024.2 045000 PERFORM PRINT-DETAIL. CM2024.2 045100 SEND-STATUS-TEST-03. CM2024.2 045200 MOVE 0 TO END-FLAG. CM2024.2 045300 MOVE 3 TO TEST-NUMB. CM2024.2 045400 MOVE 61 TO OUT-LENGTH. CM2024.2 045500 SEND CM-OUTQUE-1 WITH END-FLAG. CM2024.2 045600 IF OUT-STATUS IS EQUAL TO "60" CM2024.2 045700 PERFORM PASS GO TO SEND-STATUS-WRITE-03. CM2024.2 045800 MOVE OUT-STATUS TO COMPUTED-STATUS. CM2024.2 045900 MOVE "60" TO CORRECT-STATUS. CM2024.2 046000 PERFORM FAIL. CM2024.2 046100 GO TO SEND-STATUS-WRITE-03. CM2024.2 046200 SEND-STATUS-DELETE-03. CM2024.2 046300 PERFORM DE-LETE. CM2024.2 046400 SEND-STATUS-WRITE-03. CM2024.2 046500 MOVE "NO SENDING AREA SPECIFIED" TO RE-MARK. CM2024.2 046600 MOVE "SEND-STATUS-TEST-03" TO PAR-NAME. CM2024.2 046700 PERFORM PRINT-DETAIL. CM2024.2 046800 SEND-STATUS-TEST-04. CM2024.2 046900 MOVE 57 TO OUT-LENGTH. CM2024.2 047000 MOVE "GARBAGE" TO SYM-DEST (2). CM2024.2 047100 SEND CM-OUTQUE-1 FROM ONE-TERMINAL-MSG WITH EMI. CM2024.2 047200 IF OUT-STATUS IS NOT EQUAL TO "20" CM2024.2 047300 MOVE OUT-STATUS TO COMPUTED-STATUS CM2024.2 047400 MOVE "STATUS SHOULD BE 20" TO CORRECT-A CM2024.2 047500 PERFORM FAIL CM2024.2 047600 ELSE IF ERR-KEY (2) IS NOT EQUAL TO "1" CM2024.2 047700 MOVE ERR-KEY (2) TO COMPUTED-STATUS CM2024.2 047800 MOVE " ERROR KEY (2) = 1" TO CORRECT-A CM2024.2 047900 PERFORM FAIL CM2024.2 048000 ELSE IF ERR-KEY (1) IS NOT EQUAL TO "0" CM2024.2 048100 MOVE ERR-KEY (1) TO COMPUTED-STATUS CM2024.2 048200 MOVE " ERROR KEY (1) = 0" TO CORRECT-A CM2024.2 048300 PERFORM FAIL CM2024.2 048400 ELSE PERFORM PASS. CM2024.2 048500 GO TO SEND-STATUS-WRITE-04. CM2024.2 048600 SEND-STATUS-DELETE-04. CM2024.2 048700 PERFORM DE-LETE. CM2024.2 048800 SEND-STATUS-WRITE-04. CM2024.2 048900 MOVE "SYMBOLIC DESTINAT""N (2) IS BAD" TO RE-MARK. CM2024.2 049000 MOVE "SEND-STATUS-TEST-04" TO PAR-NAME. CM2024.2 049100 PERFORM PRINT-DETAIL. CM2024.2 049200 MOVE CM2024.2 049300 XXXXX035 CM2024.2 049400 TO SYM-DEST (2). CM2024.2 049500 SEGMENTED-MSG-TEST-01. CM2024.2 049600 MOVE 1 TO SEG-TEST-NO. CM2024.2 049700 MOVE 39 TO OUT-LENGTH. CM2024.2 049800 SEND CM-OUTQUE-1 FROM SEG-INIT WITH ESI. CM2024.2 049900 MOVE 14 TO OUT-LENGTH. CM2024.2 050000 SEND CM-OUTQUE-1 FROM MSG-COMP WITH EMI. CM2024.2 050100 SEGMENTED-MSG-TEST-02. CM2024.2 050200 MOVE 2 TO SEG-TEST-NO. CM2024.2 050300 MOVE 39 TO OUT-LENGTH. CM2024.2 050400 SEND CM-OUTQUE-1 FROM SEG-INIT WITH ESI. CM2024.2 050500 MOVE 16 TO OUT-LENGTH. CM2024.2 050600 SEND CM-OUTQUE-1 FROM GROUP-COMP WITH EGI. CM2024.2 050700 SEGMENTED-MSG-TEST-03. CM2024.2 050800 MOVE 3 TO SEG-TEST-NO. CM2024.2 050900 MOVE 39 TO OUT-LENGTH. CM2024.2 051000 SEND CM-OUTQUE-1 FROM SEG-INIT. CM2024.2 051100 MOVE 10 TO OUT-LENGTH. CM2024.2 051200 SEND CM-OUTQUE-1 FROM SEG-CONT WITH ESI. CM2024.2 051300 MOVE 14 TO OUT-LENGTH. CM2024.2 051400 SEND CM-OUTQUE-1 FROM MSG-COMP WITH EMI. CM2024.2 051500 SEGMENTED-MSG-TEST-04. CM2024.2 051600 MOVE 4 TO SEG-TEST-NO. CM2024.2 051700 MOVE 0 TO END-FLAG. CM2024.2 051800 MOVE 39 TO OUT-LENGTH. CM2024.2 051900 SEND CM-OUTQUE-1 FROM SEG-INIT WITH END-FLAG. CM2024.2 052000 MOVE 1 TO END-FLAG. CM2024.2 052100 MOVE 10 TO OUT-LENGTH. CM2024.2 052200 SEND CM-OUTQUE-1 FROM SEG-CONT WITH END-FLAG. CM2024.2 052300 MOVE 2 TO END-FLAG. CM2024.2 052400 MOVE 14 TO OUT-LENGTH. CM2024.2 052500 SEND CM-OUTQUE-1 FROM MSG-COMP WITH END-FLAG. CM2024.2 052600 MOVE 3 TO END-FLAG. CM2024.2 052700 MOVE 16 TO OUT-LENGTH. CM2024.2 052800 SEND CM-OUTQUE-1 FROM GROUP-COMP WITH END-FLAG. CM2024.2 052900 SEGMENTED-MSG-TEST-05. CM2024.2 053000 MOVE 71 TO OUT-LENGTH. CM2024.2 053100 MOVE 0 TO END-FLAG. CM2024.2 053200 SEND CM-OUTQUE-1 FROM SKIP-MSG-1 WITH END-FLAG CM2024.2 053300 BEFORE ADVANCING 4 LINES. CM2024.2 053400 MOVE 17 TO OUT-LENGTH. CM2024.2 053500 MOVE 3 TO END-FLAG. CM2024.2 053600 SEND CM-OUTQUE-1 FROM SKIP-MSG-2 WITH END-FLAG. CM2024.2 053700 SINGLE-TERMINAL-TEST-01. CM2024.2 053800 MOVE 1 TO DEST-COUNT. CM2024.2 053900 MOVE 57 TO OUT-LENGTH. CM2024.2 054000 SEND CM-OUTQUE-1 FROM ONE-TERMINAL-MSG WITH EGI. CM2024.2 054100 MOVE 2 TO DEST-COUNT. CM2024.2 054200 INCOMPLETE-MSG-TEST-01. CM2024.2 054300 MOVE 55 TO OUT-LENGTH. CM2024.2 054400 MOVE 1 TO INC-MSG-NO. CM2024.2 054500 SEND CM-OUTQUE-1 FROM INCOMP-MSG. CM2024.2 054600 INCOMPLETE-MSG-TEST-02. CM2024.2 054700 MOVE 55 TO OUT-LENGTH. CM2024.2 054800 MOVE 2 TO INC-MSG-NO. CM2024.2 054900 SEND CM-OUTQUE-1 FROM INCOMP-MSG WITH ESI. CM2024.2 055000 INCOMPLETE-MSG-TEST-03. CM2024.2 055100 MOVE 0 TO END-FLAG. CM2024.2 055200 MOVE 55 TO OUT-LENGTH. CM2024.2 055300 MOVE 3 TO INC-MSG-NO. CM2024.2 055400 SEND CM-OUTQUE-1 FROM INCOMP-MSG WITH END-FLAG. CM2024.2 055500 INCOMPLETE-MSG-TEST-04. CM2024.2 055600 MOVE 1 TO END-FLAG. CM2024.2 055700 MOVE 55 TO OUT-LENGTH. CM2024.2 055800 MOVE 4 TO INC-MSG-NO. CM2024.2 055900 SEND CM-OUTQUE-1 FROM INCOMP-MSG WITH END-FLAG. CM2024.2 056000 STOP-WITHOUT-COMPLETING-MSG. CM2024.2 056100 PERFORM END-ROUTINE THRU END-ROUTINE-4. CM2024.2 056200 CLOSE PRINT-FILE. CM2024.2 056300 STOP RUN. CM2024.2 056400 DELAY-FOR-30 SECTION. CM2024.2 056500 TAKE-INIT-TIME. CM2024.2 056600 ACCEPT INIT-TIME FROM TIME. CM2024.2 056700 TEST-ELAPSED-TIME. CM2024.2 056800 ACCEPT TEST-TIME FROM TIME. CM2024.2 056900 COMPUTE ELAPSED-TIME = CM2024.2 057000 (T-HRS * 3600 + T-MINS * 60 + T-SECS) - CM2024.2 057100 (I-HRS * 3600 + I-MINS * 60 + I-SECS). CM2024.2 057200 IF ELAPSED-TIME IS LESS THAN 30 GO TO TEST-ELAPSED-TIME. CM2024.2 057300 COMMON-SUBROUTINES SECTION. CM2024.2 057400 PASS. CM2024.2 057500 MOVE "PASS" TO P-OR-F. CM2024.2 057600 FAIL. CM2024.2 057700 ADD 1 TO ERROR-COUNTER. CM2024.2 057800 MOVE "FAIL*" TO P-OR-F. CM2024.2 057900 DE-LETE. CM2024.2 058000 MOVE SPACE TO P-OR-F. CM2024.2 058100 MOVE " ************ " TO COMPUTED-A. CM2024.2 058200 MOVE " ************ " TO CORRECT-A. CM2024.2 058300 MOVE "****TEST DELETED****" TO RE-MARK. CM2024.2 058400 ADD 1 TO DELETE-CNT. CM2024.2 058500 PRINT-DETAIL. CM2024.2 058600 MOVE TEST-RESULTS TO PRINT-REC. CM2024.2 058700 PERFORM WRITE-LINE. CM2024.2 058800 MOVE SPACE TO P-OR-F. CM2024.2 058900 MOVE SPACE TO COMPUTED-A. CM2024.2 059000 MOVE SPACE TO CORRECT-A. CM2024.2 059100 MOVE SPACE TO RE-MARK. CM2024.2 059200 MOVE SPACE TO FEATURE. CM2024.2 059300 COLUMN-NAMES-ROUTINE. CM2024.2 059400 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. CM2024.2 059500 PERFORM WRITE-LINE. CM2024.2 059600 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. CM2024.2 059700 PERFORM WRITE-LINE. CM2024.2 059800 PERFORM BLANK-LINE-PRINT. CM2024.2 059900 END-ROUTINE. CM2024.2 060000 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM2024.2 060100 PERFORM WRITE-LINE. CM2024.2 060200 PARA-Z. CM2024.2 060300 PERFORM BLANK-LINE-PRINT 4 TIMES. CM2024.2 060400 MOVE CCVS-E-1 TO DUMMY-RECORD. CM2024.2 060500 PERFORM WRITE-LINE. CM2024.2 060600 END-ROUTINE-1. CM2024.2 060700 PERFORM BLANK-LINE-PRINT. CM2024.2 060800 IF ERROR-COUNTER IS EQUAL TO ZERO CM2024.2 060900 GO TO END-ROUTINE-2. CM2024.2 061000 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM2024.2 061100 GO TO END-ROUTINE-3. CM2024.2 061200 END-ROUTINE-2. CM2024.2 061300 MOVE " NO" TO ERROR-TOTAL. CM2024.2 061400 END-ROUTINE-3. CM2024.2 061500 MOVE CCVS-E-2 TO DUMMY-RECORD. CM2024.2 061600 PERFORM WRITE-LINE. CM2024.2 061700 IF DELETE-CNT IS EQUAL TO ZERO CM2024.2 061800 MOVE " NO" TO ERROR-TOTAL ELSE CM2024.2 061900 MOVE DELETE-CNT TO ERROR-TOTAL. CM2024.2 062000 MOVE "TESTS DELETED " TO ENDER-DESC. CM2024.2 062100 MOVE CCVS-E-2 TO DUMMY-RECORD. CM2024.2 062200 PERFORM WRITE-LINE. CM2024.2 062300 END-ROUTINE-4. CM2024.2 062400 MOVE CCVS-E-3 TO DUMMY-RECORD. CM2024.2 062500 PERFORM WRITE-LINE. CM2024.2 062600 BLANK-LINE-PRINT. CM2024.2 062700 MOVE SPACE TO DUMMY-RECORD. CM2024.2 062800 PERFORM WRITE-LINE. CM2024.2 062900 WRITE-LINE. CM2024.2 063000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM2024.2 063100 HEAD-ROUTINE. CM2024.2 063200 MOVE CCVS-H-1 TO PRINT-REC CM2024.2 063300 WRITE PRINT-REC CM2024.2 063400 AFTER ADVANCING PAGE. CM2024.2 063500 MOVE CCVS-H-2 TO PRINT-REC. CM2024.2 063600 WRITE PRINT-REC CM2024.2 063700 AFTER 2 LINES. CM2024.2 063800 MOVE CCVS-H-3 TO PRINT-REC. CM2024.2 063900 WRITE PRINT-REC CM2024.2 064000 AFTER 5 LINES. CM2024.2 064100 MOVE HYPHEN-LINE TO PRINT-REC. CM2024.2 064200 PERFORM WRITE-LINE. CM2024.2 *END-OF,CM202M *HEADER,COBOL,CM303M 000100 IDENTIFICATION DIVISION. CM3034.2 000200 PROGRAM-ID. CM3034.2 000300 CM303M. CM3034.2 000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF CM3034.2 000500*OBSOLETE FEATURES THAT ARE USED IN COMMUNICATIONS. CM3034.2 000600 ENVIRONMENT DIVISION. CM3034.2 000700 CONFIGURATION SECTION. CM3034.2 000800 SOURCE-COMPUTER. CM3034.2 000900 XXXXX082. CM3034.2 001000 OBJECT-COMPUTER. CM3034.2 001100 XXXXX083. CM3034.2 001200 CM3034.2 001300 CM3034.2 001400 DATA DIVISION. CM3034.2 001500 FILE SECTION. CM3034.2 001600 COMMUNICATION SECTION. CM3034.2 001700 CD COMMNAME FOR INITIAL INPUT. CM3034.2 001800 01 CREC. CM3034.2 001900 03 CNAME1 PIC X(87). CM3034.2 002000 CM3034.2 002100 PROCEDURE DIVISION. CM3034.2 002200 CM3034.2 002300 CM303M-CONTROL. CM3034.2 002400 PERFORM CM303M-DISABLE THRU CM303M-ENABLE. CM3034.2 002500 STOP RUN. CM3034.2 002600 CM3034.2 002700 CM303M-DISABLE. CM3034.2 002800 DISABLE INPUT COMMNAME WITH KEY CNAME1. CM3034.2 002900*Message expected for above statement: OBSOLETE CM3034.2 003000 CM3034.2 003100 CM303M-ENABLE. CM3034.2 003200 ENABLE INPUT COMMNAME WITH KEY CNAME1. CM3034.2 003300*Message expected for above statement: OBSOLETE CM3034.2 003400 CM3034.2 003500*TOTAL NUMBER OF FLAGS EXPECTED = 2. CM3034.2 *END-OF,CM303M *HEADER,COBOL,CM401M 000100 IDENTIFICATION DIVISION. CM4014.2 000200 PROGRAM-ID. CM4014.2 000300 CM401M. CM4014.2 000400*The following program tests the flagging of level 2 CM4014.2 000500*features of the communication module. CM4014.2 000600 ENVIRONMENT DIVISION. CM4014.2 000700 CONFIGURATION SECTION. CM4014.2 000800 SOURCE-COMPUTER. CM4014.2 000900 XXXXX082. CM4014.2 001000 OBJECT-COMPUTER. CM4014.2 001100 XXXXX083. CM4014.2 001200 DATA DIVISION. CM4014.2 001300 FILE SECTION. CM4014.2 001400 COMMUNICATION SECTION. CM4014.2 001500 CD COMMNAME FOR INITIAL INPUT CM4014.2 001600*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 001700 SYMBOLIC SUB-QUEUE-1 IS CQ. CM4014.2 001800*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 001900 01 CREC. CM4014.2 002000 03 CNAME1 PIC X(8). CM4014.2 002100 03 CQ PIC 9(8). CM4014.2 002200 03 FILLER PIC X(62). CM4014.2 002300 03 CINT PIC 9. CM4014.2 002400 03 FILLER PIC X(8). CM4014.2 002500 CM4014.2 002600 CD COMM2 FOR OUTPUT CM4014.2 002700 DESTINATION TABLE OCCURS 7 TIMES. CM4014.2 002800*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 002900 CM4014.2 003000 PROCEDURE DIVISION. CM4014.2 003100 CM4014.2 003200 CM401M-CONTROL. CM4014.2 003300 PERFORM CM401M-DISABLE THRU CM401M-SENDREP. CM4014.2 003400 STOP RUN. CM4014.2 003500 CM4014.2 003600 CM401M-DISABLE. CM4014.2 003700 DISABLE INPUT COMMNAME WITH KEY CNAME1. CM4014.2 003800*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 003900 CM4014.2 004000 CM401M-ENABLE. CM4014.2 004100 ENABLE INPUT COMMNAME WITH KEY CNAME1. CM4014.2 004200*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 004300 CM4014.2 004400 CM4014.2 004500 CM401M-PURGE. CM4014.2 004600 PURGE COMM2. CM4014.2 004700*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 004800 CM4014.2 004900 CM401M-SEND. CM4014.2 005000 SEND COMM2 FROM CNAME1. CM4014.2 005100*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 005200 CM4014.2 005300 CM401M-SENDID. CM4014.2 005400 SEND COMM2 FROM CNAME1 WITH CINT. CM4014.2 005500*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 005600 CM4014.2 005700 CM401M-SENDESI. CM4014.2 005800 SEND COMM2 FROM CNAME1 WITH ESI. CM4014.2 005900*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 006000 CM4014.2 006100 CM401M-SENDREP. CM4014.2 006200 SEND COMM2 WITH EMI REPLACING LINE. CM4014.2 006300*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 006400 CM4014.2 006500*TOTAL NUMBER OF FLAGS EXPECTED = 10. CM4014.2 *END-OF,CM401M *HEADER,COBOL,DB101A 000100 IDENTIFICATION DIVISION. DB1014.2 000200 PROGRAM-ID. DB1014.2 000300 DB101A. DB1014.2 000400 AUTHOR. DB1014.2 000500 FEDERAL COMPILER TESTING CENTER. DB1014.2 000600 INSTALLATION. DB1014.2 000700 GENERAL SERVICES ADMINISTRATION DB1014.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB1014.2 000900 SOFTWARE DEVELOPMENT OFFICE. DB1014.2 001000 5203 LEESBURG PIKE SUITE 1100 DB1014.2 001100 FALLS CHURCH VIRGINIA 22041. DB1014.2 001200 DB1014.2 001300 PHONE (703) 756-6153 DB1014.2 001400 DB1014.2 001500 " HIGH ". DB1014.2 001600 DATE-WRITTEN. DB1014.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB1014.2 001800 CREATION DATE / VALIDATION DATE DB1014.2 001900 "4.2 ". DB1014.2 002000 SECURITY. DB1014.2 002100 NONE. DB1014.2 002200* DB1014.2 002300* * * * * * * * * * * * * * * * * * * * * *DB1014.2 002400* DB1014.2 002500* PROGRAM ABSTRACT DB1014.2 002600* DB1014.2 002700* DB101A TESTS THE BASIC OPERATION OF THE DEBUG MODULE WHEN DB1014.2 002800* BOTH THE COMPILE AND OBJECT TIME DEBUGGING SWITCHES ARE DB1014.2 002900* TURNED ON. THE PROGRAM CONTAINS BOTH DEBUG LINES AND SIMPLE DB1014.2 003000* DEBUGGING PROCEDURES. THE DEBUGGING PROCEDURES ARE SPECI- DB1014.2 003100* FIED FOR PROCEDURE-NAMES AND PROCEDURE-NAME SERIES. THE DB1014.2 003200* FOLLOWING CONDITIONS ARE EVALUATED FOR THE "DEBUG-ITEM" DB1014.2 003300* REGISTER DB1014.2 003400* DB1014.2 003500* (1) START OF PROGRAM DB1014.2 003600* (2) REFERENCE BY "ALTER" DB1014.2 003700* (3) REFERENCE BY "GO TO" DB1014.2 003800* (4) REFERENCE BY "PERFORM" DB1014.2 003900* (5) SEQUENTIAL PASSAGE OF CONTROL (FALL THROUGH) DB1014.2 004000* DB1014.2 004100* BEFORE BEGINNING EXECUTION OF THE OBJECT PROGRAM, DB1014.2 004200* WHATEVER JOB CONTROL LANGUAGE IS NECESSARY TO ACTIVATE DB1014.2 004300* (TURN ON) THE OBJECT TIME DEBUGGING SWITCH SHOULD BE DB1014.2 004400* SUBMITTED. DB1014.2 004500* DB1014.2 004600* DB1014.2 004700* DB1014.2 004800* DB1014.2 004900 ENVIRONMENT DIVISION. DB1014.2 005000 CONFIGURATION SECTION. DB1014.2 005100 SOURCE-COMPUTER. DB1014.2 005200 XXXXX082 DB1014.2 005300 WITH DEBUGGING MODE. DB1014.2 005400 OBJECT-COMPUTER. DB1014.2 005500 XXXXX083. DB1014.2 005600 INPUT-OUTPUT SECTION. DB1014.2 005700 FILE-CONTROL. DB1014.2 005800 SELECT PRINT-FILE ASSIGN TO DB1014.2 005900 XXXXX055. DB1014.2 006000 DATA DIVISION. DB1014.2 006100 FILE SECTION. DB1014.2 006200 FD PRINT-FILE DB1014.2 006300 LABEL RECORDS DB1014.2 006400 XXXXX084 DB1014.2 006500 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB1014.2 006600 01 PRINT-REC PICTURE X(120). DB1014.2 006700 01 DUMMY-RECORD PICTURE X(120). DB1014.2 006800 WORKING-STORAGE SECTION. DB1014.2 006900 77 A PIC 9 COMP VALUE 1. DB1014.2 007000 77 B PIC 9 COMP VALUE 5. DB1014.2 007100 77 C PIC 9 COMP VALUE 9. DB1014.2 007200 77 D PIC 99 COMP. DB1014.2 007300 77 RESULT-FLAG PIC 99 VALUE 0. DB1014.2 007400 77 DBLINE-HOLD PIC X(6). DB1014.2 007500 77 DBNAME-HOLD PIC X(30). DB1014.2 007600 77 DBCONT-HOLD PIC X(30). DB1014.2 007700 77 FIVE PIC 9 COMP VALUE 5. DB1014.2 007800 01 SIZE-19. DB1014.2 007900 02 FILLER PIC X. DB1014.2 008000 02 SIZE-18. DB1014.2 008100 03 FILLER PIC X. DB1014.2 008200 03 SIZE-17. DB1014.2 008300 04 FILLER PIC X. DB1014.2 008400 04 SIZE-16. DB1014.2 008500 05 FILLER PIC X. DB1014.2 008600 05 SIZE-15. DB1014.2 008700 06 FILLER PIC X. DB1014.2 008800 06 SIZE-14. DB1014.2 008900 07 FILLER PIC X. DB1014.2 009000 07 SIZE-13. DB1014.2 009100 08 FILLER PIC X. DB1014.2 009200 08 SIZE-12. DB1014.2 009300 09 FILLER PIC XX. DB1014.2 009400 09 SIZE-10. DB1014.2 009500 10 FILLER PICTURE X(5). DB1014.2 009600 10 SIZE-5 PICTURE X(5). DB1014.2 009700 01 TEST-RESULTS. DB1014.2 009800 02 FILLER PICTURE X VALUE SPACE. DB1014.2 009900 02 FEATURE PICTURE X(20) VALUE SPACE. DB1014.2 010000 02 FILLER PICTURE X VALUE SPACE. DB1014.2 010100 02 P-OR-F PICTURE X(5) VALUE SPACE. DB1014.2 010200 02 FILLER PICTURE X VALUE SPACE. DB1014.2 010300 02 PAR-NAME. DB1014.2 010400 03 FILLER PICTURE X(12) VALUE SPACE. DB1014.2 010500 03 PARDOT-X PICTURE X VALUE SPACE. DB1014.2 010600 03 DOTVALUE PICTURE 99 VALUE ZERO. DB1014.2 010700 03 FILLER PIC X(5) VALUE SPACE. DB1014.2 010800 02 FILLER PIC X(10) VALUE SPACE. DB1014.2 010900 02 RE-MARK PIC X(61). DB1014.2 011000 01 TEST-COMPUTED. DB1014.2 011100 02 FILLER PIC X(30) VALUE SPACE. DB1014.2 011200 02 FILLER PIC X(17) VALUE " COMPUTED=". DB1014.2 011300 02 COMPUTED-X. DB1014.2 011400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB1014.2 011500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB1014.2 011600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB1014.2 011700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB1014.2 011800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB1014.2 011900 03 CM-18V0 REDEFINES COMPUTED-A. DB1014.2 012000 04 COMPUTED-18V0 PICTURE -9(18). DB1014.2 012100 04 FILLER PICTURE X. DB1014.2 012200 03 FILLER PIC X(50) VALUE SPACE. DB1014.2 012300 01 TEST-CORRECT. DB1014.2 012400 02 FILLER PIC X(30) VALUE SPACE. DB1014.2 012500 02 FILLER PIC X(17) VALUE " CORRECT =". DB1014.2 012600 02 CORRECT-X. DB1014.2 012700 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB1014.2 012800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB1014.2 012900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB1014.2 013000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB1014.2 013100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB1014.2 013200 03 CR-18V0 REDEFINES CORRECT-A. DB1014.2 013300 04 CORRECT-18V0 PICTURE -9(18). DB1014.2 013400 04 FILLER PICTURE X. DB1014.2 013500 03 FILLER PIC X(50) VALUE SPACE. DB1014.2 013600 01 CCVS-C-1. DB1014.2 013700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB1014.2 013800- "SS PARAGRAPH-NAME DB1014.2 013900- " REMARKS". DB1014.2 014000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB1014.2 014100 01 CCVS-C-2. DB1014.2 014200 02 FILLER PICTURE IS X VALUE IS SPACE. DB1014.2 014300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB1014.2 014400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB1014.2 014500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB1014.2 014600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB1014.2 014700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB1014.2 014800 01 REC-CT PICTURE 99 VALUE ZERO. DB1014.2 014900 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB1014.2 015000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB1014.2 015100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB1014.2 015200 01 PASS-COUNTER PIC 999 VALUE ZERO. DB1014.2 015300 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB1014.2 015400 01 ERROR-HOLD PIC 999 VALUE ZERO. DB1014.2 015500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB1014.2 015600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB1014.2 015700 01 CCVS-H-1. DB1014.2 015800 02 FILLER PICTURE X(27) VALUE SPACE. DB1014.2 015900 02 FILLER PICTURE X(67) VALUE DB1014.2 016000 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB1014.2 016100- " SYSTEM". DB1014.2 016200 02 FILLER PICTURE X(26) VALUE SPACE. DB1014.2 016300 01 CCVS-H-2. DB1014.2 016400 02 FILLER PICTURE X(52) VALUE IS DB1014.2 016500 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB1014.2 016600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB1014.2 016700 02 TEST-ID PICTURE IS X(9). DB1014.2 016800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB1014.2 016900 01 CCVS-H-3. DB1014.2 017000 02 FILLER PICTURE X(34) VALUE DB1014.2 017100 " FOR OFFICIAL USE ONLY ". DB1014.2 017200 02 FILLER PICTURE X(58) VALUE DB1014.2 017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB1014.2 017400 02 FILLER PICTURE X(28) VALUE DB1014.2 017500 " COPYRIGHT 1974 ". DB1014.2 017600 01 CCVS-E-1. DB1014.2 017700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB1014.2 017800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB1014.2 017900 02 ID-AGAIN PICTURE IS X(9). DB1014.2 018000 02 FILLER PICTURE X(45) VALUE IS DB1014.2 018100 " NTIS DISTRIBUTION COBOL 74". DB1014.2 018200 01 CCVS-E-2. DB1014.2 018300 02 FILLER PICTURE X(31) VALUE DB1014.2 018400 SPACE. DB1014.2 018500 02 FILLER PICTURE X(21) VALUE SPACE. DB1014.2 018600 02 CCVS-E-2-2. DB1014.2 018700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB1014.2 018800 03 FILLER PICTURE IS X VALUE IS SPACE. DB1014.2 018900 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB1014.2 019000 01 CCVS-E-3. DB1014.2 019100 02 FILLER PICTURE X(22) VALUE DB1014.2 019200 " FOR OFFICIAL USE ONLY". DB1014.2 019300 02 FILLER PICTURE X(12) VALUE SPACE. DB1014.2 019400 02 FILLER PICTURE X(58) VALUE DB1014.2 019500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB1014.2 019600 02 FILLER PICTURE X(13) VALUE SPACE. DB1014.2 019700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB1014.2 019800 01 CCVS-E-4. DB1014.2 019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB1014.2 020000 02 FILLER PIC XXXX VALUE " OF ". DB1014.2 020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB1014.2 020200 02 FILLER PIC X(40) VALUE DB1014.2 020300 " TESTS WERE EXECUTED SUCCESSFULLY". DB1014.2 020400 01 XXINFO. DB1014.2 020500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB1014.2 020600 02 INFO-TEXT. DB1014.2 020700 04 FILLER PIC X(20) VALUE SPACE. DB1014.2 020800 04 XXCOMPUTED PIC X(20). DB1014.2 020900 04 FILLER PIC X(5) VALUE SPACE. DB1014.2 021000 04 XXCORRECT PIC X(20). DB1014.2 021100 01 HYPHEN-LINE. DB1014.2 021200 02 FILLER PICTURE IS X VALUE IS SPACE. DB1014.2 021300 02 FILLER PICTURE IS X(65) VALUE IS "************************DB1014.2 021400- "*****************************************". DB1014.2 021500 02 FILLER PICTURE IS X(54) VALUE IS "************************DB1014.2 021600- "******************************". DB1014.2 021700 01 CCVS-PGM-ID PIC X(6) VALUE DB1014.2 021800 "DB101A". DB1014.2 021900 PROCEDURE DIVISION. DB1014.2 022000 DECLARATIVES. DB1014.2 022100 START-UP SECTION. DB1014.2 022200 USE FOR DEBUGGING ON CCVS1. DB1014.2 022300 BEGIN-START-UP. DB1014.2 022400 MOVE 1 TO RESULT-FLAG. DB1014.2 022500 DB-COMMON. DB1014.2 022600 MOVE DEBUG-LINE TO DBLINE-HOLD. DB1014.2 022700 MOVE DEBUG-NAME TO DBNAME-HOLD. DB1014.2 022800 MOVE DEBUG-CONTENTS TO DBCONT-HOLD. DB1014.2 022900 FALL-THROUGH-AND-SERIES SECTION. DB1014.2 023000 USE FOR DEBUGGING ON FALL-THROUGH-TEST DB1014.2 023100 PROC-SERIES-TEST. DB1014.2 023200 BEGIN-FALL-THROUGH-AND-SERIES. DB1014.2 023300 PERFORM DB-COMMON. DB1014.2 023400 MOVE 2 TO RESULT-FLAG. DB1014.2 023500 GO-TO SECTION. DB1014.2 023600 USE FOR DEBUGGING ON GO-TO-TEST. DB1014.2 023700 BEGIN-GO-TO. DB1014.2 023800 PERFORM DB-COMMON. DB1014.2 023900 MOVE 3 TO RESULT-FLAG. DB1014.2 024000 ALTER-PARAGRAPH SECTION. DB1014.2 024100 USE FOR DEBUGGING ON ALTERABLE-PARAGRAPH. DB1014.2 024200 BEGIN-ALTER-PARAGRAPH. DB1014.2 024300 PERFORM DB-COMMON. DB1014.2 024400 MOVE 4 TO RESULT-FLAG. DB1014.2 024500 LOOP-ITERATION SECTION. DB1014.2 024600 USE FOR DEBUGGING ON LOOP-ROUTINE. DB1014.2 024700 BEGIN-LOOP-ITERATION. DB1014.2 024800 PERFORM DB-COMMON. DB1014.2 024900 ADD 1 TO RESULT-FLAG. DB1014.2 025000 PERFORM-THRU SECTION. DB1014.2 025100 USE FOR DEBUGGING ON DO-NOTHING-1. DB1014.2 025200 BEGIN-PERFORM-THRU. DB1014.2 025300 PERFORM DB-COMMON. DB1014.2 025400 ADD 1 TO RESULT-FLAG. DB1014.2 025500 END DECLARATIVES. DB1014.2 025600******************************************************************DB1014.2 025700* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 025800* OUTPUT REPORT AS "START-PROGRAM-TEST" SHOULD POINT TO THE *DB1014.2 025900* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 026000* WHICH READS, "OPEN OUTPUT PRINT-FILE." *DB1014.2 026100******************************************************************DB1014.2 026200 CCVS1 SECTION. DB1014.2 026300 OPEN-FILES. DB1014.2 026400 OPEN OUTPUT PRINT-FILE. DB1014.2 026500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB1014.2 026600 MOVE SPACE TO TEST-RESULTS. DB1014.2 026700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB1014.2 026800 GO TO CCVS1-EXIT. DB1014.2 026900 CLOSE-FILES. DB1014.2 027000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB1014.2 027100 TERMINATE-CCVS. DB1014.2 027200S EXIT PROGRAM. DB1014.2 027300STERMINATE-CALL. DB1014.2 027400 STOP RUN. DB1014.2 027500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1014.2 027600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1014.2 027700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1014.2 027800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1014.2 027900 MOVE "****TEST DELETED****" TO RE-MARK. DB1014.2 028000 PRINT-DETAIL. DB1014.2 028100 IF REC-CT NOT EQUAL TO ZERO DB1014.2 028200 MOVE "." TO PARDOT-X DB1014.2 028300 MOVE REC-CT TO DOTVALUE. DB1014.2 028400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB1014.2 028500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB1014.2 028600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB1014.2 028700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB1014.2 028800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1014.2 028900 MOVE SPACE TO CORRECT-X. DB1014.2 029000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1014.2 029100 MOVE SPACE TO RE-MARK. DB1014.2 029200 HEAD-ROUTINE. DB1014.2 029300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 029400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB1014.2 029500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB1014.2 029600 COLUMN-NAMES-ROUTINE. DB1014.2 029700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 029800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 029900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 030000 END-ROUTINE. DB1014.2 030100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB1014.2 030200 END-RTN-EXIT. DB1014.2 030300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 030400 END-ROUTINE-1. DB1014.2 030500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB1014.2 030600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB1014.2 030700 ADD PASS-COUNTER TO ERROR-HOLD. DB1014.2 030800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB1014.2 030900 MOVE PASS-COUNTER TO CCVS-E-4-1. DB1014.2 031000 MOVE ERROR-HOLD TO CCVS-E-4-2. DB1014.2 031100 MOVE CCVS-E-4 TO CCVS-E-2-2. DB1014.2 031200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB1014.2 031300 END-ROUTINE-12. DB1014.2 031400 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB1014.2 031500 IF ERROR-COUNTER IS EQUAL TO ZERO DB1014.2 031600 MOVE "NO " TO ERROR-TOTAL DB1014.2 031700 ELSE DB1014.2 031800 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB1014.2 031900 MOVE CCVS-E-2 TO DUMMY-RECORD. DB1014.2 032000 PERFORM WRITE-LINE. DB1014.2 032100 END-ROUTINE-13. DB1014.2 032200 IF DELETE-CNT IS EQUAL TO ZERO DB1014.2 032300 MOVE "NO " TO ERROR-TOTAL ELSE DB1014.2 032400 MOVE DELETE-CNT TO ERROR-TOTAL. DB1014.2 032500 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB1014.2 032600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 032700 IF INSPECT-COUNTER EQUAL TO ZERO DB1014.2 032800 MOVE "NO " TO ERROR-TOTAL DB1014.2 032900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB1014.2 033000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB1014.2 033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 033200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 033300 WRITE-LINE. DB1014.2 033400 ADD 1 TO RECORD-COUNT. DB1014.2 033500Y IF RECORD-COUNT GREATER 50 DB1014.2 033600Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1014.2 033700Y MOVE SPACE TO DUMMY-RECORD DB1014.2 033800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1014.2 033900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB1014.2 034000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB1014.2 034100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB1014.2 034200Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1014.2 034300Y MOVE ZERO TO RECORD-COUNT. DB1014.2 034400 PERFORM WRT-LN. DB1014.2 034500 WRT-LN. DB1014.2 034600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1014.2 034700 MOVE SPACE TO DUMMY-RECORD. DB1014.2 034800 BLANK-LINE-PRINT. DB1014.2 034900 PERFORM WRT-LN. DB1014.2 035000 FAIL-ROUTINE. DB1014.2 035100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1014.2 035200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1014.2 035300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1014.2 035400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 035500 GO TO FAIL-ROUTINE-EX. DB1014.2 035600 FAIL-ROUTINE-WRITE. DB1014.2 035700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB1014.2 035800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB1014.2 035900 FAIL-ROUTINE-EX. EXIT. DB1014.2 036000 BAIL-OUT. DB1014.2 036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB1014.2 036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB1014.2 036300 BAIL-OUT-WRITE. DB1014.2 036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1014.2 036500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 036600 BAIL-OUT-EX. EXIT. DB1014.2 036700 CCVS1-EXIT. DB1014.2 036800 EXIT. DB1014.2 036900 START-PROGRAM-TEST. DB1014.2 037000 IF RESULT-FLAG IS NOT EQUAL TO 1 DB1014.2 037100 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 037200 PERFORM FAIL DB1014.2 037300 GO TO START-PROGRAM-WRITE. DB1014.2 037400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 037500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 037600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 037700 PERFORM INSPT. DB1014.2 037800 PERFORM START-PROGRAM-WRITE. DB1014.2 037900 MOVE DBNAME-HOLD TO SIZE-5. DB1014.2 038000 IF SIZE-5 IS EQUAL TO "CCVS1" DB1014.2 038100 PERFORM PASS ELSE DB1014.2 038200 MOVE "CCVS1" TO CORRECT-A DB1014.2 038300 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 038400 PERFORM FAIL. DB1014.2 038500 START-PROGRAM-TEST-1. DB1014.2 038600 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 038700 PERFORM START-PROGRAM-WRITE. DB1014.2 038800 MOVE DBCONT-HOLD TO SIZE-13. DB1014.2 038900 IF SIZE-13 IS EQUAL TO "START PROGRAM" DB1014.2 039000 PERFORM PASS ELSE DB1014.2 039100 MOVE "START PROGRAM" TO CORRECT-A DB1014.2 039200 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 039300 PERFORM FAIL. DB1014.2 039400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 039500 GO TO START-PROGRAM-WRITE. DB1014.2 039600 START-PROGRAM-DELETE. DB1014.2 039700 PERFORM DE-LETE. DB1014.2 039800 START-PROGRAM-WRITE. DB1014.2 039900 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 040000 MOVE "START-PROGRAM-TEST" TO PAR-NAME. DB1014.2 040100 PERFORM PRINT-DETAIL. DB1014.2 040200******************************************************************DB1014.2 040300* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 040400* OUTPUT REPORT AS "FALL-THROUGH-TEST" SHOULD POINT TO THE *DB1014.2 040500* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 040600* WHICH READS, "MOVE 0 TO RESULT-FLAG." *DB1014.2 040700******************************************************************DB1014.2 040800 MOVE 0 TO RESULT-FLAG. DB1014.2 040900 FALL-THROUGH-TEST. DB1014.2 041000 IF RESULT-FLAG IS NOT EQUAL TO 2 DB1014.2 041100 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 041200 PERFORM FAIL DB1014.2 041300 GO TO FALL-THROUGH-WRITE. DB1014.2 041400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 041500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 041600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 041700 PERFORM INSPT. DB1014.2 041800 PERFORM FALL-THROUGH-WRITE. DB1014.2 041900 MOVE DBNAME-HOLD TO SIZE-17. DB1014.2 042000 IF SIZE-17 IS EQUAL TO "FALL-THROUGH-TEST" DB1014.2 042100 PERFORM PASS ELSE DB1014.2 042200 MOVE "FALL-THROUGH-TEST" TO CORRECT-A DB1014.2 042300 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 042400 PERFORM FAIL. DB1014.2 042500 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 042600 PERFORM FALL-THROUGH-WRITE. DB1014.2 042700 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 042800 IF SIZE-12 IS EQUAL TO "FALL THROUGH" DB1014.2 042900 PERFORM PASS ELSE DB1014.2 043000 MOVE "FALL THROUGH" TO CORRECT-A DB1014.2 043100 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 043200 PERFORM FAIL. DB1014.2 043300 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 043400 GO TO FALL-THROUGH-WRITE. DB1014.2 043500 FALL-THROUGH-DELETE. DB1014.2 043600 PERFORM DE-LETE. DB1014.2 043700 FALL-THROUGH-WRITE. DB1014.2 043800 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 043900 MOVE "FALL-THROUGH-TEST" TO PAR-NAME. DB1014.2 044000 PERFORM PRINT-DETAIL. DB1014.2 044100******************************************************************DB1014.2 044200* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 044300* OUTPUT REPORT AS "PROC-SERIES-TEST" SHOULD POINT TO THE *DB1014.2 044400* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 044500* WHICH READS, "MOVE 0 TO RESULT-FLAG." *DB1014.2 044600******************************************************************DB1014.2 044700 MOVE 0 TO RESULT-FLAG. DB1014.2 044800 PROC-SERIES-TEST. DB1014.2 044900 IF RESULT-FLAG IS NOT EQUAL TO 2 DB1014.2 045000 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 045100 PERFORM FAIL DB1014.2 045200 GO TO PROC-SERIES-WRITE. DB1014.2 045300 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 045400 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 045500 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 045600 PERFORM INSPT. DB1014.2 045700 PERFORM PROC-SERIES-WRITE. DB1014.2 045800 MOVE DBNAME-HOLD TO SIZE-16. DB1014.2 045900 IF SIZE-16 IS EQUAL TO "PROC-SERIES-TEST" DB1014.2 046000 PERFORM PASS ELSE DB1014.2 046100 MOVE "PROC-SERIES-TEST" TO CORRECT-A DB1014.2 046200 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 046300 PERFORM FAIL. DB1014.2 046400 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 046500 PERFORM PROC-SERIES-WRITE. DB1014.2 046600 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 046700 IF SIZE-12 IS EQUAL TO "FALL THROUGH" DB1014.2 046800 PERFORM PASS ELSE DB1014.2 046900 MOVE "FALL THROUGH" TO CORRECT-A DB1014.2 047000 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 047100 PERFORM FAIL. DB1014.2 047200 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 047300 GO TO PROC-SERIES-WRITE. DB1014.2 047400 PROC-SERIES-DELETE. DB1014.2 047500 PERFORM DE-LETE. DB1014.2 047600 PROC-SERIES-WRITE. DB1014.2 047700 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 047800 MOVE "PROC-SERIES-TEST" TO PAR-NAME. DB1014.2 047900 PERFORM PRINT-DETAIL. DB1014.2 048000 MOVE 0 TO RESULT-FLAG. DB1014.2 048100******************************************************************DB1014.2 048200* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 048300* OUTPUT REPORT AS "GO-TO-TEST" SHOULD POINT TO THE *DB1014.2 048400* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 048500* WHICH READS, "GO TO GO-TO-TEST.". *DB1014.2 048600******************************************************************DB1014.2 048700 ALTERABLE-PARAGRAPH. DB1014.2 048800 GO TO GO-TO-TEST. DB1014.2 048900 FILLER-PARAGRAPH. DB1014.2 049000 DISPLAY "ALTER FAILED AT ALTER-TEST-INIT". DB1014.2 049100 PERFORM FAIL. DB1014.2 049200 GO TO ALTERED-GO-TO-TEST. DB1014.2 049300 GO-TO-TEST. DB1014.2 049400 IF RESULT-FLAG IS NOT EQUAL TO 3 DB1014.2 049500 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 049600 PERFORM FAIL DB1014.2 049700 GO TO GO-TO-WRITE. DB1014.2 049800 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 049900 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 050000 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 050100 PERFORM INSPT. DB1014.2 050200 PERFORM GO-TO-WRITE. DB1014.2 050300 MOVE DBNAME-HOLD TO SIZE-10. DB1014.2 050400 IF SIZE-10 IS EQUAL TO "GO-TO-TEST" DB1014.2 050500 PERFORM PASS ELSE DB1014.2 050600 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 050700 MOVE "GO-TO-TEST" TO CORRECT-A DB1014.2 050800 PERFORM FAIL. DB1014.2 050900 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 051000 PERFORM GO-TO-WRITE. DB1014.2 051100 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 051200 IF SIZE-12 IS EQUAL TO SPACE DB1014.2 051300 PERFORM PASS DB1014.2 051400 ELSE DB1014.2 051500 PERFORM FAIL DB1014.2 051600 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 051700 MOVE "SPACES" TO CORRECT-A. DB1014.2 051800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 051900 GO TO GO-TO-WRITE. DB1014.2 052000 GO-TO-DELETE. DB1014.2 052100 PERFORM DE-LETE. DB1014.2 052200 GO-TO-WRITE. DB1014.2 052300 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 052400 MOVE "GO-TO-TEST" TO PAR-NAME. DB1014.2 052500 PERFORM PRINT-DETAIL. DB1014.2 052600 MOVE 0 TO RESULT-FLAG. DB1014.2 052700******************************************************************DB1014.2 052800* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 052900* OUTPUT REPORT AS "ALTER-TEST" SHOULD POINT TO THE *DB1014.2 053000* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 053100* WHICH READS, "ALTER ALTERABLE-PARAGRAPH TO PROCEED TO *DB1014.2 053200* ALTERED-GO-TO-TEST.". *DB1014.2 053300******************************************************************DB1014.2 053400 ALTER-TEST-INIT. DB1014.2 053500 ALTER ALTERABLE-PARAGRAPH TO PROCEED TO ALTERED-GO-TO-TEST. DB1014.2 053600 ALTER-TEST. DB1014.2 053700 IF RESULT-FLAG IS NOT EQUAL TO 4 DB1014.2 053800 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 053900 PERFORM FAIL DB1014.2 054000 GO TO ALTER-WRITE. DB1014.2 054100 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 054200 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 054300 MOVE DBLINE-HOLD TO COMPUTED-A DB1014.2 054400 PERFORM INSPT. DB1014.2 054500 PERFORM ALTER-WRITE. DB1014.2 054600 MOVE DBNAME-HOLD TO SIZE-19. DB1014.2 054700 IF SIZE-19 IS EQUAL TO "ALTERABLE-PARAGRAPH" DB1014.2 054800 PERFORM PASS ELSE DB1014.2 054900 MOVE "ALTERABLE-PARAGRAPH" TO CORRECT-A DB1014.2 055000 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 055100 PERFORM FAIL. DB1014.2 055200 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 055300 PERFORM ALTER-WRITE. DB1014.2 055400 MOVE DBCONT-HOLD TO SIZE-18. DB1014.2 055500 IF SIZE-18 IS EQUAL TO "ALTERED-GO-TO-TEST" DB1014.2 055600 PERFORM PASS ELSE DB1014.2 055700 MOVE "ALTERED-GO-TO-TEST" TO CORRECT-A DB1014.2 055800 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 055900 PERFORM FAIL. DB1014.2 056000 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 056100 GO TO ALTER-WRITE. DB1014.2 056200 ALTER-DELETE. DB1014.2 056300 PERFORM DE-LETE. DB1014.2 056400 ALTER-WRITE. DB1014.2 056500 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 056600 MOVE "ALTER-TEST" TO PAR-NAME. DB1014.2 056700 PERFORM PRINT-DETAIL. DB1014.2 056800 MOVE 0 TO RESULT-FLAG. DB1014.2 056900******************************************************************DB1014.2 057000* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 057100* OUTPUT REPORT AS "ALTERED-GO-TO-TEST" SHOULD POINT TO THE *DB1014.2 057200* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 057300* WHICH READS, "GO TO ALTERABLE-PARAGRAPH.". *DB1014.2 057400******************************************************************DB1014.2 057500 ALTER-WRITE-END. DB1014.2 057600 GO TO ALTERABLE-PARAGRAPH. DB1014.2 057700 ALTERED-GO-TO-TEST. DB1014.2 057800 IF RESULT-FLAG IS NOT EQUAL TO 4 DB1014.2 057900 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 058000 PERFORM FAIL DB1014.2 058100 GO TO ALTERED-GO-TO-WRITE. DB1014.2 058200 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 058300 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 058400 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 058500 PERFORM INSPT. DB1014.2 058600 PERFORM ALTERED-GO-TO-WRITE. DB1014.2 058700 MOVE DBNAME-HOLD TO SIZE-19. DB1014.2 058800 IF SIZE-19 IS EQUAL TO "ALTERABLE-PARAGRAPH" DB1014.2 058900 PERFORM PASS ELSE DB1014.2 059000 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 059100 MOVE "ALTERABLE-PARAGRAPH" TO CORRECT-A DB1014.2 059200 PERFORM FAIL. DB1014.2 059300 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 059400 PERFORM ALTERED-GO-TO-WRITE. DB1014.2 059500 IF DBCONT-HOLD EQUAL TO SPACE DB1014.2 059600 PERFORM PASS DB1014.2 059700 ELSE DB1014.2 059800 PERFORM FAIL DB1014.2 059900 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 060000 MOVE "SPACES" TO CORRECT-A. DB1014.2 060100 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 060200 GO TO ALTERED-GO-TO-WRITE. DB1014.2 060300 ALTERED-GO-TO-DELETE. DB1014.2 060400 PERFORM DE-LETE. DB1014.2 060500 ALTERED-GO-TO-WRITE. DB1014.2 060600 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 060700 MOVE "ALTERED-GO-TO-TEST" TO PAR-NAME. DB1014.2 060800 PERFORM PRINT-DETAIL. DB1014.2 060900 MOVE 0 TO RESULT-FLAG. DB1014.2 061000******************************************************************DB1014.2 061100* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 --> -------------------- --> maximum size reached --> -------------------- [Seitenstruktur0.504Druckenetwas mehr zur Ethik2026-04-27] |
2026-05-26