Quelle ix104a.cob
Sprache: Cobol
000100 IDENTIFICATION DIVISION . IX1044.2PROGRAM-ID . IX1044.2000400**************************************************************** IX1044.2 000500* * IX1044.2 000600* VALIDATION FOR:- * IX1044.2 000700* * IX1044.2 000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1044.2 000900* * IX1044.2 001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1044.2 001100* * IX1044.2 001200**************************************************************** IX1044.2 001300* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND SEMANTIC IX1044.2 001400* ACTIONS ASSOCIATED WITH THE FOLLOWING ELEMENTS: IX1044.2 001500* IX1044.2 001600* (1) FILE STATUS IX1044.2 001700* (2) USE AFTER EXCEPTION USING FILE-NAME IX1044.2 001800* (3) READ IX1044.2 001900* (4) WRITE IX1044.2 002000* (5) REWRITE IX1044.2 002100* (6) RECORD KEY IX1044.2 002200* (7) ACCESS IX1044.2 002300* IX1044.2 002400* THIS PROGRAM CREATES AN INDEXED FILE SEQUENTIALLY (ACCESS IX1044.2 002500* MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RECORDS OF THE IX1044.2 002600* FILE. THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR IX1044.2 002700* ACCURACY FOR EACH OPEN, CLOSE, READ AND REWRITE STATEMENT IX1044.2 002800* USED. THE READ, WRITE AND REWRITE STATEMENTS ARE USED IX1044.2 002900* WITHOUT THE APPROPRIATE AT END OR INVALID KEY PHRASES. THE IX1044.2 003000* OMISSION OF THESE PHRASES ARE PERMITTED IF AN APPLICABLE USE IX1044.2 003100* PROCEDURE HAS BEEN SPECIFIED. IX1044.2 003200* IX1044.2 003300* IX1044.2 003400* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1044.2 003500* IX1044.2 003600* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1044.2 003700* CLAUSE FOR DATA FILE IX-FD2 IX1044.2 003800* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1044.2 003900* CLAUSE FOR INDEX FILE IX-FD2 IX1044.2 004000* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1044.2 004100* X-62 FOR RAW-DATA IX1044.2 004200* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1044.2 004300* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1044.2 004400* IX1044.2 004500* NOTE: X-CARDS 45 AND 62 ARE OPTIONAL IX1044.2 004600* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1044.2 004700* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1044.2 004800* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1044.2 004900* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1044.2 005000* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1044.2 005100* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1044.2 005200* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1044.2 005300* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1044.2 005400* THEY ARE AS FOLLOWS IX1044.2 005500* IX1044.2 005600* J SELECTS X-CARD 45 IX1044.2 005700* IX1044.2 005800****************************************************** IX1044.2 ENVIRONMENT DIVISION . IX1044.2CONFIGURATION SECTION . IX1044.2SOURCE-COMPUTER . IX1044.2OBJECT-COMPUTER . IX1044.2INPUT-OUTPUT SECTION . IX1044.2FILE-CONTROL . IX1044.2SELECT RAW-DATA ASSIGN TO IX1044.2"C0098" IX1044.2ORGANIZATION IS INDEXED IX1044.2ACCESS MODE IS RANDOM IX1044.2RECORD KEY IS RAW-DATA-KEY. IX1044.2SELECT PRINT-FILE ASSIGN TO IX1044.2"C0085" . IX1044.2SELECT IX-FS2 ASSIGN IX1044.2"C0037" IX1044.2"C0069" IX1044.2ORGANIZATION IS INDEXED IX1044.2ACCESS SEQUENTIAL IX1044.2FILE STATUS IS IX-FS2-STATUS IX1044.2RECORD IX-FS2-KEY. IX1044.2DATA DIVISION . IX1044.2FILE SECTION . IX1044.2FD RAW-DATA. IX1044.2PIC X(6). IX1044.2PIC 9(6). IX1044.2PIC 9(8). IX1044.2PIC 99. IX1044.2PIC 999. IX1044.2PIC 999. IX1044.2PIC 999. IX1044.2PIC 999. IX1044.2PIC 999. IX1044.2PIC X(13). IX1044.2PIC X. IX1044.2PIC X(8). IX1044.2FD PRINT-FILE. IX1044.2PICTURE X(120). IX1044.2PICTURE X(120). IX1044.2FD IX-FS2 IX1044.2LABEL RECORDS ARE STANDARD IX1044.2DATA RECORDS IX-FS2R1-F-G-240 IX1044.2BLOCK CONTAINS 480 IX1044.2RECORD CONTAINS 240 CHARACTERS. IX1044.2PIC X(120). IX1044.2FILLER PICTURE X(8). IX1044.2PIC X(29). IX1044.2FILLER PIC X(83). IX1044.2WORKING-STORAGE SECTION . IX1044.2FILLER PIC X(10) VALUE "ABCD921XYZ" . IX1044.2PIC 9(9) VALUE ZERO . IX1044.2FILLER PIC X(10) VALUE "Z2F()$+-AB" . IX1044.2PIC S9(9) USAGE COMP VALUE ZERO . IX1044.2PIC S9(9) USAGE COMP VALUE ZERO . IX1044.2PIC S9(9) USAGE COMP VALUE ZERO . IX1044.2PIC S9(9) USAGE COMP VALUE ZERO . IX1044.2PIC S9(9) USAGE COMP VALUE ZERO . IX1044.2PIC S9(9) USAGE COMP VALUE ZERO . IX1044.2PIC S9(9) USAGE COMP VALUE ZERO . IX1044.2PIC XX VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(2) VALUE SPACE . IX1044.2PIC X(120). IX1044.2REDEFINES DUMMY-WRK1. IX1044.2FILLER PIC X(5). IX1044.2PIC X(115). IX1044.2FILLER PICTURE X(48) VALUE IX1044.2"FILE= ,RECORD= /0,RECNO=000000,UPDT=00" . IX1044.2FILLER PICTURE X(46) VALUE IX1044.2",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000" . IX1044.2FILLER PICTURE X(26) VALUE IX1044.2",LFIL=000000,ORG= ,LBLR= " . IX1044.2FILLER PICTURE X(37) VALUE IX1044.2",RECKEY= " . IX1044.2FILLER PICTURE X(38) VALUE IX1044.2",ALTKEY1= " . IX1044.2FILLER PICTURE X(38) VALUE IX1044.2",ALTKEY2= " . IX1044.2FILLER PICTURE X(7) VALUE SPACE .IX1044.2OCCURS 10 TIMES. IX1044.2FILLER PIC X(5). IX1044.2PIC X(6). IX1044.2FILLER PIC X(8). IX1044.2PIC X(6). IX1044.2FILLER PIC X(1). IX1044.2PIC 9(1). IX1044.2FILLER PIC X(7). IX1044.2PIC 9(6). IX1044.2FILLER PIC X(6). IX1044.2PIC 9(2). IX1044.2FILLER PIC X(5). IX1044.2PIC 9(4). IX1044.2FILLER PIC X(5). IX1044.2PIC X(5). IX1044.2FILLER PIC X(7). IX1044.2PIC 9(6). IX1044.2FILLER PIC X(7). IX1044.2PIC X(2). IX1044.2FILLER PIC X(1). IX1044.2PIC 9(4). IX1044.2FILLER PIC X(6). IX1044.2PIC 9(6). IX1044.2FILLER PIC X(5). IX1044.2PIC X(2). IX1044.2FILLER PIC X(6). IX1044.2PIC X(1). IX1044.2FILLER PIC X(8). IX1044.2PIC X(29). IX1044.2FILLER PIC X(9). IX1044.2PIC X(29). IX1044.2FILLER PIC X(9). IX1044.2PIC X(29). IX1044.2FILLER PIC X(7). IX1044.2FILLER PIC X VALUE SPACE . IX1044.2PIC X(20) VALUE SPACE . IX1044.2FILLER PIC X VALUE SPACE . IX1044.2PIC X(5) VALUE SPACE . IX1044.2FILLER PIC X VALUE SPACE . IX1044.2FILLER PIC X(19) VALUE SPACE . IX1044.2PIC X VALUE SPACE . IX1044.2PIC 99 VALUE ZERO . IX1044.2FILLER PIC X(8) VALUE SPACE . IX1044.2PIC X(61). IX1044.2FILLER PIC X(30) VALUE SPACE . IX1044.2FILLER PIC X(17) VALUE IX1044.2" COMPUTED=" . IX1044.2PIC X(20) VALUE SPACE . IX1044.2REDEFINES COMPUTED-A IX1044.2PIC -9(9).9(9). IX1044.2REDEFINES COMPUTED-A PIC -.9(18). IX1044.2REDEFINES COMPUTED-A PIC -9(4).9(14). IX1044.2REDEFINES COMPUTED-A PIC -9(14).9(4). IX1044.2REDEFINES COMPUTED-A. IX1044.2PIC -9(18). IX1044.2FILLER PIC X. IX1044.2FILLER PIC X(50) VALUE SPACE . IX1044.2FILLER PIC X(30) VALUE SPACE . IX1044.2FILLER PIC X(17) VALUE " CORRECT =" . IX1044.2PIC X(20) VALUE SPACE . IX1044.2REDEFINES CORRECT-A PIC -9(9).9(9). IX1044.2REDEFINES CORRECT-A PIC -.9(18). IX1044.2REDEFINES CORRECT-A PIC -9(4).9(14). IX1044.2REDEFINES CORRECT-A PIC -9(14).9(4). IX1044.2REDEFINES CORRECT-A. IX1044.2PIC -9(18). IX1044.2FILLER PIC X. IX1044.2FILLER PIC X(2) VALUE SPACE . IX1044.2PIC X(48) VALUE SPACE . IX1044.2FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1044.2 "SS PARAGRAPH-NAME IX1044.2 " REMARKS" . IX1044.2FILLER PIC X(20) VALUE SPACE . IX1044.2FILLER PIC X VALUE SPACE . IX1044.2FILLER PIC X(6) VALUE "TESTED" . IX1044.2FILLER PIC X(15) VALUE SPACE . IX1044.2FILLER PIC X(4) VALUE "FAIL" . IX1044.2FILLER PIC X(94) VALUE SPACE . IX1044.2PIC 9(2) VALUE ZERO . IX1044.2PIC 99 VALUE ZERO . IX1044.2PIC 999 VALUE ZERO . IX1044.2PIC 999 VALUE ZERO . IX1044.2PIC 999 VALUE ZERO . IX1044.2PIC 999 VALUE ZERO . IX1044.2PIC 999 VALUE ZERO . IX1044.2PIC 999 VALUE ZERO . IX1044.2PIC X(120) VALUE SPACE . IX1044.2PIC 9(5) VALUE ZERO . IX1044.2PIC X(48) VALUE SPACES . IX1044.2FILLER PIC X(39) VALUE SPACES . IX1044.2FILLER PIC X(42) VALUE IX1044.2"OFFICIAL COBOL COMPILER VALIDATION SYSTEM" . IX1044.2FILLER PIC X(39) VALUE SPACES . IX1044.2FILLER PIC X(40) VALUE SPACE . IX1044.2FILLER PIC X(7) VALUE "CCVS85 " . IX1044.2FILLER PIC XXXX VALUE IX1044.2"4.2 " . IX1044.2FILLER PIC X(28) VALUE IX1044.2" COPY - NOT FOR DISTRIBUTION" . IX1044.2FILLER PIC X(41) VALUE SPACE . IX1044.2FILLER PIC X(15) VALUE IX1044.2"TEST RESULT OF " . IX1044.2PIC X(9). IX1044.2FILLER PIC X(4) VALUE IX1044.2" IN " . IX1044.2FILLER PIC X(12) VALUE IX1044.2" HIGH " . IX1044.2FILLER PIC X(22) VALUE IX1044.2" LEVEL VALIDATION FOR " . IX1044.2FILLER PIC X(58) VALUE IX1044.2"ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. " .IX1044.2FILLER PIC X(34) VALUE IX1044.2" FOR OFFICIAL USE ONLY " . IX1044.2FILLER PIC X(58) VALUE IX1044.2"COBOL 85 VERSION 4.2, Apr 1993 SSVG " .IX1044.2FILLER PIC X(28) VALUE IX1044.2" COPYRIGHT 1985 " . IX1044.2FILLER PIC X(52) VALUE SPACE . IX1044.2FILLER PIC X(14) VALUE IS "END OF TEST- " . IX1044.2PIC X(9). IX1044.2FILLER PIC X(45) VALUE SPACES . IX1044.2FILLER PIC X(31) VALUE SPACE . IX1044.2FILLER PIC X(21) VALUE SPACE . IX1044.2PIC XXX VALUE SPACE . IX1044.2FILLER PIC X VALUE SPACE . IX1044.2PIC X(44) VALUE IX1044.2"ERRORS ENCOUNTERED" . IX1044.2FILLER PIC X(22) VALUE IX1044.2" FOR OFFICIAL USE ONLY" . IX1044.2FILLER PIC X(12) VALUE SPACE . IX1044.2FILLER PIC X(58) VALUE IX1044.2"ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. " .IX1044.2FILLER PIC X(13) VALUE SPACE . IX1044.2FILLER PIC X(15) VALUE IX1044.2" COPYRIGHT 1985" . IX1044.2PIC XXX VALUE SPACE . IX1044.2FILLER PIC X(4) VALUE " OF " . IX1044.2PIC XXX VALUE SPACE . IX1044.2FILLER PIC X(40) VALUE IX1044.2" TESTS WERE EXECUTED SUCCESSFULLY" . IX1044.2FILLER PIC X(19) VALUE IX1044.2"*** INFORMATION ***" . IX1044.2FILLER PIC X(8) VALUE SPACE . IX1044.2PIC X(20). IX1044.2FILLER PIC X(5) VALUE SPACE . IX1044.2PIC X(20). IX1044.2PIC X(48). IX1044.2FILLER PIC IS X VALUE IS SPACE . IX1044.2FILLER PIC IS X(65) VALUE IS "************************IX1044.2 "*****************************************" . IX1044.2FILLER PIC IS X(54) VALUE IS "************************IX1044.2 "******************************" . IX1044.2PIC X(9) VALUE IX1044.2"IX104A" . IX1044.2PROCEDURE DIVISION . IX1044.2DECLARATIVES . IX1044.2SECTION . IX1044.2USE AFTER STANDARD ERROR PROCEDURE ON IX-FS2. IX1044.2ADD 1 TO WRK-CS-09V00-013. IX1044.2GO TO IX-FS2-01-03 IX1044.2DEPENDING ON WRK-CS-09V00-012. IX1044.2GO TO IX-FS2-01-EXIT. IX1044.2034400*ENTRY FROM SEGMENT INX-TEST-001. IX1044.2 034500* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX1044.2 ADD 1 TO WRK-CS-09V00-014. IX1044.2ADD 1 TO WRK-CS-09V00-017. IX1044.2IF XRECORD-NUMBER (2) EQUAL TO 500 IX1044.2MOVE IX-FS2-STATUS TO WRK-XN-0002-002 IX1044.2MOVE "10" TO WRK-XN-0002-003. IX1044.2EXIT . IX1044.2END DECLARATIVES . IX1044.2SECTION . IX1044.2OPEN I-O RAW-DATA. IX1044.2MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1044.2READ RAW-DATA INVALID KEY GO TO END-E-1. IX1044.2MOVE "ABORTED " TO C-ABORT. IX1044.2ADD 1 TO C-NO-OF-TESTS. IX1044.2ACCEPT C-DATE FROM DATE . IX1044.2ACCEPT C-TIME FROM TIME . IX1044.2REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1044.2CLOSE RAW-DATA. IX1044.2OPEN OUTPUT PRINT-FILE. IX1044.2MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1044.2MOVE SPACE TO TEST-RESULTS. IX1044.2PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1044.2MOVE ZERO TO REC-SKL-SUB. IX1044.2PERFORM CCVS-INIT-FILE 9 TIMES. IX1044.2ADD 1 TO REC-SKL-SUB. IX1044.2MOVE FILE-RECORD-INFO-SKELETON IX1044.2TO FILE-RECORD-INFO (REC-SKL-SUB). IX1044.2GO TO CCVS1-EXIT. IX1044.2OPEN I-O RAW-DATA. IX1044.2MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1044.2READ RAW-DATA INVALID KEY GO TO END-E-2. IX1044.2MOVE "OK. " TO C-ABORT. IX1044.2MOVE PASS-COUNTER TO C-OK. IX1044.2MOVE ERROR-HOLD TO C-ALL. IX1044.2MOVE ERROR-COUNTER TO C-FAIL. IX1044.2MOVE DELETE-COUNTER TO C-DELETED. IX1044.2MOVE INSPECT-COUNTER TO C-INSPECT. IX1044.2REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1044.2CLOSE RAW-DATA. IX1044.2PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1044.2EXIT PROGRAM . IX1044.2STOP RUN . IX1044.2MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1044.2MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1044.2MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1044.2MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1044.2MOVE "****TEST DELETED****" TO RE-MARK. IX1044.2IF REC-CT NOT EQUAL TO ZERO IX1044.2MOVE "." TO PARDOT-X IX1044.2MOVE REC-CT TO DOTVALUE. IX1044.2MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1044.2IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1044.2PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1044.2ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1044.2MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1044.2MOVE SPACE TO CORRECT-X. IX1044.2IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1044.2MOVE SPACE TO RE-MARK. IX1044.2MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1044.2MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1044.2MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1044.2MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1044.2ADD DELETE-COUNTER TO ERROR-HOLD. IX1044.2ADD PASS-COUNTER TO ERROR-HOLD. IX1044.2043100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1044.2 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1044.2MOVE ERROR-HOLD TO CCVS-E-4-2. IX1044.2MOVE CCVS-E-4 TO CCVS-E-2-2. IX1044.2MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1044.2MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1044.2IF ERROR-COUNTER IS EQUAL TO ZERO IX1044.2MOVE "NO " TO ERROR-TOTAL IX1044.2ELSE IX1044.2MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1044.2MOVE CCVS-E-2 TO DUMMY-RECORD. IX1044.2PERFORM WRITE-LINE. IX1044.2IF DELETE-COUNTER IS EQUAL TO ZERO IX1044.2MOVE "NO " TO ERROR-TOTAL ELSE IX1044.2MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1044.2MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1044.2MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2IF INSPECT-COUNTER EQUAL TO ZERO IX1044.2MOVE "NO " TO ERROR-TOTAL IX1044.2ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1044.2MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1044.2MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2ADD 1 TO RECORD-COUNT. IX1044.2IF RECORD-COUNT GREATER 42 IX1044.2MOVE DUMMY-RECORD TO DUMMY-HOLD IX1044.2MOVE SPACE TO DUMMY-RECORD IX1044.2WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1044.2MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1044.2MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1044.2MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1044.2MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1044.2MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1044.2MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1044.2MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1044.2MOVE DUMMY-HOLD TO DUMMY-RECORD IX1044.2MOVE ZERO TO RECORD-COUNT. IX1044.2PERFORM WRT-LN. IX1044.2WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1044.2MOVE SPACE TO DUMMY-RECORD. IX1044.2PERFORM WRT-LN. IX1044.2IF COMPUTED-X NOT EQUAL TO SPACE IX1044.2GO TO FAIL-ROUTINE-WRITE. IX1044.2IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1044.2MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1044.2MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1044.2MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2MOVE SPACES TO INF-ANSI-REFERENCE. IX1044.2GO TO FAIL-ROUTINE-EX. IX1044.2MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1044.2MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1044.2MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1044.2MOVE SPACES TO COR-ANSI-REFERENCE. IX1044.2EXIT . IX1044.2IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1044.2IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1044.2MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1044.2MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1044.2MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2MOVE SPACES TO INF-ANSI-REFERENCE. IX1044.2EXIT . IX1044.2EXIT . IX1044.2SECTION . IX1044.2MOVE "CREATE IX-FS2" TO FEATURE IX1044.2MOVE "IX-FS2" TO XFILE-NAME (2). IX1044.2MOVE "R1-F-G" TO XRECORD-NAME (2). IX1044.2MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX1044.2MOVE 000240 TO XRECORD-LENGTH (2). IX1044.2MOVE "RC" TO CHARS-OR-RECORDS (2). IX1044.2MOVE 0001 TO XBLOCK-SIZE (2). IX1044.2MOVE 000500 TO RECORDS-IN-FILE (2). IX1044.2MOVE "IX" TO XFILE-ORGANIZATION (2). IX1044.2MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1044.2MOVE "S" TO XLABEL-TYPE (2). IX1044.2MOVE 000001 TO XRECORD-NUMBER (2). IX1044.2051700*INITIALIZE RECORD WORK AREA NUMBER 2. IX1044.2 MOVE 1 TO WRK-CS-09V00-012. IX1044.2MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX1044.2MOVE SPACE TO IX-FS2-STATUS. IX1044.2MOVE ZERO TO WRK-DU-09V00-001. IX1044.2OPEN OUTPUT IX-FS2. IX1044.2MOVE GRP-0101 TO IX-FS2-KEY. IX1044.2MOVE IX-FS2-STATUS TO WRK-XN-0002-001. IX1044.2052700*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. IX1044.2 MOVE "99" TO IX-FS2-STATUS. IX1044.2MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX1044.2MOVE GRP-0101 TO XRECORD-KEY (2). IX1044.2MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX1044.2WRITE IX-FS2R1-F-G-240. IX1044.2IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2ADD 1 TO WRK-CS-09V00-016. IX1044.2IF XRECORD-NUMBER (2) EQUAL TO 500 IX1044.2GO TO WRITE-TEST-GF-01-2. IX1044.2ADD 01 TO XRECORD-NUMBER (2). IX1044.2GO TO WRITE-TEST-GF-01. IX1044.2IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX1044.2MOVE "EXCEPTIONS/ERRORS" TO RE-MARK IX1044.2MOVE ZERO TO CORRECT-18V0 IX1044.2MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1044.2MOVE "IX-41 4.9.2 " TO RE-MARKIX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "CREATE IX-FS2" TO FEATURE IX1044.2MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1044.2IF XRECORD-NUMBER (2) NOT EQUAL TO 500 IX1044.2MOVE "INCORRECT COUNT" TO RE-MARK IX1044.2MOVE 500 TO CORRECT-18V0 IX1044.2MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX1044.2MOVE "IX-41 4.9.2 " TO RE-MARKIX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "OPEN: 00 EXP. " TO FEATURE. IX1044.2MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX1044.2IF WRK-XN-0002-001 NOT EQUAL TO "00" IX1044.2MOVE WRK-XN-0002-001 TO COMPUTED-A IX1044.2MOVE "00" TO CORRECT-A IX1044.2MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "WRITE: 00 EXP." TO FEATURE. IX1044.2MOVE "WRITE-TEST-GF-04" TO PAR-NAME. IX1044.2IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2MOVE "00" TO CORRECT-A IX1044.2MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "WRITE: 00 EXP. " TO FEATURE. IX1044.2MOVE "WRITE-TEST-GF-05" TO PAR-NAME. IX1044.2IF WRK-CS-09V00-016 NOT EQUAL TO ZERO IX1044.2MOVE ZERO TO CORRECT-18V0 IX1044.2MOVE WRK-CS-09V00-016 TO COMPUTED-18V0 IX1044.2MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "CLOSE: 00 EXP. " TO FEATURE. IX1044.2MOVE "WRITE-TEST-GF-06" TO PAR-NAME. IX1044.2MOVE SPACE TO IX-FS2-STATUS. IX1044.2CLOSE IX-FS2. IX1044.2IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2MOVE "CLOSE/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX1044.2MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2MOVE "00" TO CORRECT-A IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE 2 TO WRK-CS-09V00-012. IX1044.2MOVE ZERO TO WRK-CS-09V00-013. IX1044.2MOVE ZERO TO WRK-CS-09V00-014. IX1044.2MOVE ZERO TO WRK-CS-09V00-015. IX1044.2MOVE ZERO TO WRK-CS-09V00-016. IX1044.2MOVE ZERO TO WRK-CS-09V00-017. IX1044.2MOVE ZERO TO WRK-CS-09V00-018. IX1044.2MOVE SPACE TO IX-FS2-STATUS. IX1044.2OPEN I-O IX-FS2. IX1044.2MOVE SPACE TO WRK-XN-0002-002 IX1044.2MOVE SPACE TO WRK-XN-0002-003 IX1044.2MOVE SPACE TO WRK-XN-0002-004 IX1044.2MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1044.2MOVE SPACE TO IX-FS2-STATUS. IX1044.2062300*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. IX1044.2 ADD 1 TO WRK-CS-09V00-014. IX1044.2ADD 1 TO WRK-CS-09V00-015. IX1044.2READ IX-FS2. IX1044.2IF IX-FS2-STATUS EQUAL TO "10" IX1044.2GO TO READ-TEST-F1-01-3. IX1044.2MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX1044.2IF WRK-CS-09V00-015 EQUAL TO 5 IX1044.2ADD 01 TO UPDATE-NUMBER (2) IX1044.2MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240 IX1044.2PERFORM READ-010-UPDATE IX1044.2MOVE ZERO TO WRK-CS-09V00-015 IX1044.2GO TO READ-TEST-F1-01-2. IX1044.2IF WRK-CS-09V00-014 GREATER 500 IX1044.2GO TO READ-TEST-F1-01-3. IX1044.2GO TO READ-TEST-F1-01. IX1044.2REWRITE IX-FS2R1-F-G-240. IX1044.2IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2ADD 1 TO WRK-CS-09V00-016. IX1044.2MOVE SPACE TO IX-FS2-STATUS. IX1044.2GO TO READ-TEST-F1-01. IX1044.2MOVE "READ: 10 EXP. " TO FEATURE. IX1044.2MOVE "READ-TEST-F1-01-3" TO PAR-NAME. IX1044.2IF WRK-CS-09V00-013 NOT EQUAL TO 1 IX1044.2MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 IX1044.2MOVE 1 TO CORRECT-18V0 IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "READ " TO FEATURE. IX1044.2MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX1044.2IF WRK-CS-09V00-014 NOT EQUAL TO 501 IX1044.2MOVE "INCORRECT COUNT IX-28 4.5.2" TO RE-MARK IX1044.2MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1044.2MOVE 501 TO CORRECT-18V0 IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "OPEN: 00 EXP. " TO FEATURE. IX1044.2MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX1044.2IF WRK-XN-0002-001 NOT EQUAL TO "00" IX1044.2MOVE "IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2MOVE WRK-XN-0002-001 TO COMPUTED-A IX1044.2MOVE "00" TO CORRECT-A IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "READ AT END: 10 EXP." TO FEATURE. IX1044.2MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX1044.2IF IX-FS2-STATUS NOT EQUAL TO "10" IX1044.2MOVE "ATEND/STATUS" TO RE-MARK IX1044.2MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2MOVE "10" TO CORRECT-A IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "READ: 10 EXP. " TO FEATURE. IX1044.2MOVE "READ-TEST-F1-05 " TO PAR-NAME. IX1044.2IF WRK-XN-0002-002 NOT EQUAL TO "10" IX1044.2MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2MOVE WRK-XN-0002-002 TO COMPUTED-A IX1044.2MOVE "10" TO CORRECT-A IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "READ NO EXCEPTION 10" TO FEATURE. IX1044.2MOVE "READ-TEST-F1-06 " TO PAR-NAME. IX1044.2IF WRK-XN-0002-003 NOT EQUAL TO "10" IX1044.2MOVE "NO/EXCEPTION IX-4 1.3.4 (2) A" TO RE-MARK IX1044.2MOVE WRK-XN-0002-003 TO COMPUTED-A IX1044.2MOVE "10" TO CORRECT-A IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2MOVE "CLOSE: 00 EXP. " TO FEATURE. IX1044.2MOVE "READ-TEST-F1-07 " TO PAR-NAME. IX1044.2MOVE SPACE TO IX-FS2-STATUS. IX1044.2CLOSE IX-FS2 IX1044.2IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2MOVE "CLOSE/STATUS IX-3 1.3.4 (1) A" TO RE-MARK IX1044.2MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2MOVE "00" TO CORRECT-A IX1044.2PERFORM FAIL IX1044.2ELSE IX1044.2PERFORM PASS. IX1044.2PERFORM PRINT-DETAIL. IX1044.2SECTION . IX1044.2GO TO CLOSE-FILES. IX1044.2quality 97%
¤ Diese beiden folgenden Angebotsgruppen bietet das Unternehmen0.40Angebot
Wie Sie bei der Firma Beratungs- und Dienstleistungen beauftragen können
¤ *Eine klare Vorstellung vom Zielzustand
2026-03-28
