$set directive"-run:system" 000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. 'BUFTEST1'. 004100/ 004200 ENVIRONMENT DIVISION. 004300 CONFIGURATION SECTION. 004400 SOURCE-COMPUTER. IBM-370. 004500 OBJECT-COMPUTER. IBM-370. 004600 INPUT-OUTPUT SECTION. 004700 FILE-CONTROL. 004800 004900*** FIXED WIDTH FILE INPUT 005000 005100 SELECT IN-CURRENT 005200 FILE STATUS IS WS-IN-CURRENT-STATUS 005300 ASSIGN TO INCURR. 005800 005900 SELECT OUT-FILE 006000 FILE STATUS IS WS-OUT-STATUS 006100 ASSIGN TO OUTFILE. 006200 006300/ 006400 DATA DIVISION. 006500 FILE SECTION. 006600 006700 FD IN-CURRENT. 006800 01 IN-CURRENT-RECORD. 007032 10 INCURR-NUMBERS PIC X(10). 10 FILLER PIC X(33). 10 INCURR-LETTERS PIC X(10). 10 FILLER PIC X(147). 009600 009700 FD OUT-FILE. 009800 01 OUT-REC PIC X(200). 009900 010000 WORKING-STORAGE SECTION. 010100/ 010200 01 WS-MISC-AREA. 010300 05 WS-DISPLAY-COUNT PIC 9(09) VALUE 0. 010400 05 WS-IN-CURRENT-COUNT PIC S9(9) VALUE +0 COMP-3. 010600 05 WS-IN-CURRENT-COUNT-GIVING PIC S9(9) VALUE +0 COMP-3. 010800 05 WS-IN-CURRENT-COUNT-REMAINDER PIC S9(9) VALUE +0 COMP-3. 010900 05 WS-IN-PREVIOUS-COUNT-REMAINDER PIC S9(9) VALUE +0 COMP-3. 011000 05 WS-IN-PDM-COUNT PIC S9(9) VALUE +0 COMP-3. 011100 05 WS-OUT-COUNT PIC S9(9) VALUE +0 COMP-3. 011200 05 WS-IN-CURRENT-STATUS PIC X(02) VALUE '00'. 011400 05 WS-IN-MMGD-STATUS PIC X(02) VALUE '00'. 011500 05 WS-IN-PDM-STATUS PIC X(02) VALUE '00'. 011600 05 WS-OUT-STATUS PIC X(02) VALUE '00'. 011700 05 WS-OUT-STATUS-DELS PIC X(02) VALUE '00'. 011800 05 WS-DELETE-OUT-STATUS PIC X(02) VALUE '00'. 011900 05 WS-CONTINUE PIC X(01) VALUE 'Y'. 012000 05 WS-CURR-EOF PIC X(01) VALUE 'N'. 012200 05 WS-DELIMITER PIC X(01) VALUE X'1C'. 012300 05 WS-TABLE-NAME PIC X(50) VALUE SPACES. 012400 05 WS-WHEN-COMPILED PIC X(25) VALUE SPACES. 012500 05 WS-TIMESTAMP PIC X(26). 012600 05 WS-END-OF-TIME PIC X(10) VALUE '9999-12-31'. 012700 012800 01 WK-000-PROGRAM-ID PIC X(08) VALUE 'BUFTEST1'. 012900 01 WK-ALL-NINES PIC 9(6)V9(6) VALUE 999999.999999. 015500/ 015600 PROCEDURE DIVISION. 015700 DISPLAY 'START TIME: ' CURRENT-TIME UPON SYSOUT. 015800 MOVE FUNCTION WHEN-COMPILED TO WS-WHEN-COMPILED. 015900 DISPLAY WK-000-PROGRAM-ID ' STARTED, COMPILED ' 016000 WS-WHEN-COMPILED. 016100 016200 PERFORM S100-000-HOUSEKEEPING. 016300 016400 MOVE 'Y' TO WS-CONTINUE. 016500 PERFORM S200-000-MAINLINE 016600 UNTIL WS-CONTINUE = 'N'. 016700 016800 PERFORM S700-000-TERMINATION. 016900 DISPLAY 'END TIME: ' CURRENT-TIME UPON SYSOUT. 017000 GOBACK. 017100 017200/ 017300 S100-000-HOUSEKEEPING SECTION. 017400* 017500****************************************************************** 017600* S100 HOUSEKEEPING * 017700* * 017800****************************************************************** 017900* 018000 S100-010-START. 018100 018200 OPEN INPUT IN-CURRENT. 018300 018400 IF WS-IN-CURRENT-STATUS = '00' 018500 CONTINUE 018600 ELSE 018700 DISPLAY 'ERROR OPENING IN-CURRENT. STATUS IS ' 018800 WS-IN-CURRENT-STATUS 018900 PERFORM S999-000-SYSTEM-ABORT 019000 END-IF. 019100 020100 020200 OPEN OUTPUT OUT-FILE. 020300 020400 IF WS-OUT-STATUS = '00' 020500 CONTINUE 020600 ELSE 020700 DISPLAY 'ERROR OPENING OUT-FILE. STATUS IS ' 020800 WS-OUT-STATUS 020900 PERFORM S999-000-SYSTEM-ABORT 021000 END-IF. 021100 021200 021300 PERFORM S810-000-READ-CURRENT. 021600 021700 S100-999-EXIT. 021800 EXIT. 021900/ 022000 S200-000-MAINLINE SECTION. 022100 022200****************************************************************** 022300* S200 MAINLINE * 022400* * 022500****************************************************************** 022600 022700 S200-010-START. 022800 023700 MOVE IN-CURRENT-RECORD TO OUT-REC. 023800 PERFORM S800-000-WRITE-OUT. 023900 PERFORM S810-000-READ-CURRENT. 024600 024700 S200-999-EXIT. 024800 EXIT. 024900/ 025000 S700-000-TERMINATION SECTION. 025100* 025200****************************************************************** 025300* S700 TERMINATION * 025400* * 025500*? THIS SECTION CLOSES ALL FILES AND PRODUCES THE PROCESS * 025600*+ SUMMARY. * 025700*+ * 025800****************************************************************** 025900* 026000 S700-010-START. 026100 026200 CLOSE IN-CURRENT 026400 OUT-FILE. 026500 026600 MOVE WS-IN-CURRENT-COUNT TO WS-DISPLAY-COUNT. 026700 DISPLAY 'IN-CURRENT-COUNT = ' 026800 WS-DISPLAY-COUNT. 027300 027400 MOVE WS-OUT-COUNT TO WS-DISPLAY-COUNT. 027500 DISPLAY 'OUT-COUNT = ' 027600 WS-DISPLAY-COUNT. 027700 027800 027900 S700-999-EXIT. 028000 EXIT. 028100 028200 S800-000-WRITE-OUT SECTION. 028300 028400 WRITE OUT-REC. 028500 028600 IF WS-OUT-STATUS = '00' 028700 ADD +1 TO WS-OUT-COUNT 028800 ELSE 028900 DISPLAY 'ERROR WRITING OUT-FILE. STATUS IS ' 029000 WS-OUT-STATUS 029100 DISPLAY OUT-REC 029200 PERFORM S999-000-SYSTEM-ABORT. 029300 S800-999-EXIT. 029400 EXIT. 029500/ 029600 S810-000-READ-CURRENT SECTION. 029700 029800 READ IN-CURRENT. 029900 030000 EVALUATE TRUE 030100 030200 WHEN WS-IN-CURRENT-STATUS = '00' 030300 ADD +1 TO WS-IN-CURRENT-COUNT 030400 DIVIDE WS-IN-CURRENT-COUNT 030500 BY 100000 030600 GIVING WS-IN-CURRENT-COUNT-GIVING 030700 REMAINDER WS-IN-CURRENT-COUNT-REMAINDER 030800 IF WS-IN-CURRENT-COUNT-REMAINDER 030900 = 0 031000 MOVE WS-IN-CURRENT-COUNT TO WS-DISPLAY-COUNT 031100 DISPLAY 'CURRENT RECORD = ' WS-DISPLAY-COUNT 031200 END-IF 032300 032400 WHEN WS-IN-CURRENT-STATUS = '10' 032500 MOVE 'Y' TO WS-CURR-EOF 032600 MOVE 'N' TO WS-CONTINUE 032700 MOVE WS-IN-CURRENT-COUNT TO WS-DISPLAY-COUNT 032800 032900 WHEN OTHER 033000 MOVE 'N' TO WS-CONTINUE 033100 DISPLAY 'BAD READ, STATUS IS ' 033200 WS-IN-CURRENT-STATUS 033300 DISPLAY 'PROGRAM ENDING EARLY' 033400 033500 END-EVALUATE. 033600 033700 S810-999-EXIT. 033800 EXIT. 033900/ 038400 038500 S999-000-SYSTEM-ABORT SECTION. DISPLAY 'BOOM' UPON SYSOUT MOVE 99 TO RETURN-CODE. STOP RUN. S999-999-EXIT. EXIT.