myvision69
Programmer
I need to extract data from a Cobol program ans I have both the DTA and KEY files.
Is there a way to convert the data into text file format?
BIG THANKS
Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Data Extraction from Cobol program ..have the DTA and KEY files 1
- Thread starter myvision69
- Start date
- Status
I need to extract data from a Cobol program ans I have both the DTA and KEY files.
Is there a way to convert the data into text file format?
BIG THANKS
-
1
- #2
fredericofonseca
IS-IT--Management
you need to tell us.
1- cobol vendor and version used to create files.
2- OS
3- by DTA and KEY files do you mean you have something the SELECT and the FD of the files (if so that is GOOD).
Of 3 is true then getting the data is easy.
Regards
Frederico Fonseca
SysSoft Integrated Ltd
1- cobol vendor and version used to create files.
2- OS
3- by DTA and KEY files do you mean you have something the SELECT and the FD of the files (if so that is GOOD).
Of 3 is true then getting the data is easy.
Regards
Frederico Fonseca
SysSoft Integrated Ltd
M
Member 310024
Guest
(1) Make your extract (output) file SELECT/ASSIGN clause
(2) Make your extract (output) file FD clause
contain only display formats (no computationals) eg
would match your ISAM file
(3)Read each input record, set up your output record, & write the output record.
This will put an "equals sign" as a delimiter between each of the output fields, making it easier to read.
Code:
SELECT Z220-FILE ASSIGN 'C:\Z220.DOC'
ORGANIZATION LINE SEQUENTIAL
ACCESS SEQUENTIAL
FILE STATUS WW-FILE-STATUS.(2) Make your extract (output) file FD clause
contain only display formats (no computationals) eg
Code:
FD Z220-FILE.
01 Z220-RECORD.
03 FILLER PIC X(01).
03 Z220-EMPLOYEE-NAME PIC X(30).
03 FILLER PIC X(01).
03 Z220-SALARY PIC 9(6).99.
03 FILLER PIC X(01).
Code:
FD I220-FILE
01 I220-RECORD.
03 I220-EMPLOYEE-NAME PIC X(30).
03 I220-SALARY PIC 9(6)V99 COMP-3.(3)Read each input record, set up your output record, & write the output record.
Code:
READ I220-FILE NEXT RECORD.
AT END
MOVE 'Y' TO WF-EOF-I220
END-READ.
IF WF-EOF-I220 NOT = 'Y'
MOVE ALL '=' TO Z220-RECORD
MOVE I220-EMPLOYEE-NAME TO Z-EMPLOYEE-NAME
MOVE I220-SALARY TO Z-SALARY
WRITE Z220-RECORD
END-IF.This will put an "equals sign" as a delimiter between each of the output fields, making it easier to read.
PROFESSORSPARKIE
Instructor
I know this is a lot of code but it is a Fujitsu COBOL that reads a simple text created data file(see layout in the code) and prints each record with calculations & loads an indexed file.
Select what you like and discard the rest.
000010****************************************************************************
000011* START OF THE IDENTIFICATION DIVISION *
000012****************************************************************************
000013 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. INV-LOAD.
000030****************************************************************************
000031* START OF THE ENVIRONMENT DIVISION *
000032****************************************************************************
000040 ENVIRONMENT DIVISION.
000050 CONFIGURATION SECTION.
000051 SPECIAL-NAMES.
000052 PRINTING MODE CHAR-TYPE IS
000053 FOR ALL
000055 IN SIZE 6 POINT
000057 AT PITCH 13
000058 WITH FONT GOTHIC
000059 AT ANGLE 0 DEGREES
000060 BY FORM F0202.
000061 INPUT-OUTPUT SECTION.
000062 FILE-CONTROL.
000070 SELECT INVENTORY-FILE-IN
000080 ASSIGN TO "C:\COBOL\INV_SRT.TXT"
000090 ORGANIZATION IS LINE SEQUENTIAL.
000100 SELECT INVENTORY-LISTING-OUT
000110 ASSIGN TO PRINTER
000120 ORGANIZATION IS SEQUENTIAL.
000130 SELECT INVENTORY-LOAD-OUT
000131 ASSIGN TO "C:\COBOL\INV_INDX.TXT"
000132 ACCESS MODE IS SEQUENTIAL
000133 ORGANIZATION IS INDEXED
000134 RECORD KEY IS ITEM IN INVENTORY-INDEX-OUT
000135 FILE STATUS IS INDEX-FEED-BACK.
000136****************************************************************************
000137* START OF THE DATA DIVISION *
000138****************************************************************************
000140 DATA DIVISION.
000150 FILE SECTION.
000160 FD INVENTORY-FILE-IN.
000170 01 INVENTORY-RECORD-IN.
000180 02 INV-RECORD-IN.
000190 03 ITEM PIC X(6).
000200 03 DESCRIPTION PIC X(20).
000210 03 UNITCOST PIC 99V99.
000211 03 UNITSELL PIC 99V99.
000212 03 ONHAND PIC 9(4).
000220 03 ONORDER PIC 9(4).
000230 03 ORDERPOINT PIC 9(4).
000280 03 FILLER PIC X(34).
000281 FD INVENTORY-LOAD-OUT.
000282 01 INVENTORY-INDEX-OUT.
000283 02 INV-INDEX-OUT.
000284 03 ITEM PIC X(6).
000285 03 DESCRIPTION PIC X(20).
000286 03 UNITCOST PIC 99V99.
000287 03 UNITSELL PIC 99V99.
000288 03 ONHAND PIC 9(4).
000289 03 ONORDER PIC 9(4).
000290 03 ORDERPOINT PIC 9(4).
000291 03 FILLER PIC X(34).
000292
000293 FD INVENTORY-LISTING-OUT.
000294 01 INVENTORY-RECORD-OUT CHARACTER TYPE CHAR-TYPE.
000300 02 INV-LINE-OUT.
000310 03 ITEM PIC X(6).
000320 03 FILLER PIC X.
000330 03 DESCRIPTION PIC X(19).
000340 03 FILLER PIC X.
000350 03 ONHAND PIC Z(4).
000360 03 FILLER PIC X(2).
000370 03 ONORDER PIC Z(4).
000380 03 FILLER PIC XX.
000390 03 ORDERPOINT PIC Z(4).
000400 03 FILLER PIC Z.
000410 03 UNITCOST PIC Z9.99.
000420 03 FILLER PIC X.
000430 03 UNITSELL PIC Z9.99.
000440 03 FILLER PIC X.
000450 03 TOTALCOST PIC $$$$,$$9.99.
000460 03 FILLER PIC XXX.
000470 03 TOTALSELL PIC $$$$,$$9.99.
000480 03 FILLER PIC XX.
000490 03 ORDERAMOUNT PIC Z(4).
000500 03 FILLER PIC XXX.
000510 03 PROFIT-RATIO-OUT PIC Z.ZZ.
000520 03 FILLER PIC X.
000530 03 ASTERISTIC PIC X.
000584 01 LINE-RECORD CHARACTER TYPE CHAR-TYPE.
000585 03 FILLER PIC X(132).
000593****************************************************************************
000594* BEGINNING OF THE WORKING STORAGE SECTION *
000595****************************************************************************
000596 WORKING-STORAGE SECTION.
000597 01 HEADING-RECORD-1.
000598 03 PIC X(42) VALUE SPACES.
000599 03 PIC X(16) VALUE "SPARKS CORP.".
000600 03 PIC X(22) VALUE SPACES.
000601 01 HEADING-RECORD-2.
000602 03 PIC X(37) VALUE SPACES.
000603 03 PIC X(22) VALUE "INVENTORY LOAD REPORT".
000604 03 PIC X(31) VALUE SPACES.
000605 03 PIC X(6) VALUE "PAGE ".
000606 03 COUNTER PIC 99.
000607 01 HEADING-RECORD-3.
000608 03 PIC X(20) VALUE " PART PART ".
000609 03 PIC X(20) VALUE " ON ON OR".
000610 03 PIC X(20) VALUE "DER UNIT UNIT ".
000611 03 PIC X(23) VALUE " TOTAL TOTAL ".
000612 03 PIC X(14) VALUE "ORDER PROFIT ".
000613 01 HEADING-RECORD-4.
000614 03 PIC X(20) VALUE " NO DESCRIPTION ".
000615 03 PIC X(20) VALUE " HAND ORDER PO".
000616 03 PIC X(20) VALUE "INT COST SELL ".
000617 03 PIC X(23) VALUE " COST SELL ".
000618 03 PIC X(14) VALUE " AMT RATIO ".
000619 01 INDEX-ERROR-REC.
000620 03 ERROR-MESSAGE PIC X(43).
000621 03 ERROR-CODE PIC X(2).
000622 01 PRINT-PAGE-TOTALS.
000623 03 FILLER PIC X(42) VALUE SPACES.
000624 03 PIC X(12) VALUE "PAGE TOTALS ".
000625 03 PRINT-PAGE-TOTAL-C PIC $$,$$$,$$9.99.
000626 03 FILLER PIC X VALUE " ".
000627 03 PRINT-PAGE-TOTAL-S PIC $$,$$$,$$9.99.
000628 01 PRINT-FINAL-TOTALS.
000629 03 FILLER PIC X(42) VALUE SPACES.
000630 03 PIC X(12) VALUE "FINAL TOTALS".
000631 03 PRINT-FINAL-TOTAL-C PIC $$,$$$,$$9.99.
000632 03 FILLER PIC X VALUE " ".
000633 03 PRINT-FINAL-TOTAL-S PIC $$,$$$,$$9.99.
000665 01 DATE-AREA.
000666 03 YEAR PIC 9999.
000667 03 MONTH PIC 99.
000668 03 WEEK-DAY PIC 99.
000669 03 HOUR PIC 99.
000670 03 MINUTES PIC 99.
000671 03 SECONDS PIC 99.
000672 03 PARTIALSECONDS PIC 99.
000673 03 DATE-SIGN PIC X.
000674 03 EXTRA PIC 9999.
000675 01 DATE-AREA-EDITED.
000676 03 FILLER PIC X(33) VALUE SPACES.
000677 03 MONTH PIC 99.
000678 03 FILLER PIC X VALUE "/".
000679 03 WEEK-DAY PIC 99.
000680 03 FILLER PIC X VALUE "/".
000681 03 YEAR PIC 9999.
000682 03 FILLER PIC XXX VALUE " ".
000683 03 HOUR PIC 99.
000684 03 FILLER PIC X VALUE ":".
000685 03 MINUTES PIC 99.
000686 03 FILLER PIC X VALUE ":".
000687 03 SECONDS PIC 99.
000688 03 FILLER PIC X VALUE ":".
000689 03 PARTIALSECONDS PIC 99.
000690 03 FILLER PIC XXX VALUE " ".
000691 03 DATE-SIGN PIC X.
000692 03 EXTRA PIC 9999.
000693 01 PAGE-TOTALCOST PIC S999999V99 COMPUTATIONAL.
000694 01 PAGE-TOTALSELL PIC S999999V99 COMPUTATIONAL.
000695 01 FINAL-TOTALCOST PIC S9999999V99 COMPUTATIONAL.
000696 01 FINAL-TOTALSELL PIC S9999999V99 COMPUTATIONAL.
000697 01 PERCENT PIC 99V9 COMPUTATIONAL.
000698 01 PROFIT-RATIO PIC 999V99 COMPUTATIONAL.
000699 01 WORK-AREA PIC S99999999V999 COMPUTATIONAL.
000700 01 AMOUNT-TO-ORDER PIC S9999 COMPUTATIONAL.
000701 01 ONEHALF PIC 99 VALUE 50.
000702 01 PAGECOUNT PIC 99 VALUE 1 COMPUTATIONAL.
000703 01 LINE-COUNT PIC 99 VALUE 0 COMPUTATIONAL.
000704 01 EOF-SWITCH PIC X VALUE "N".
000705 01 INDEX-FEED-BACK PIC XX VALUE IS SPACES.
000706****************************************************************************
000707* START OF THE PROCEDURE DIVISION *
000708****************************************************************************
000709 PROCEDURE DIVISION.
000710****************************************************************************
000711* START OF HOUSEKEEPING PROCEDURE *
000712****************************************************************************
000713 HOUSEKEEPING.
000714 OPEN INPUT INVENTORY-FILE-IN.
000715 OPEN OUTPUT INVENTORY-LOAD-OUT.
000716 OPEN OUTPUT INVENTORY-LISTING-OUT.
000717 MOVE FUNCTION CURRENT-DATE TO DATE-AREA.
000718 MOVE CORR DATE-AREA TO DATE-AREA-EDITED.
000726 PERFORM HEADING-ROUTINE.
000727****************************************************************************
000728* START OF ROUTINE TO READ THE RECORDS AND PROCESS THEM, PROCEDURE *
000729****************************************************************************
000730 GET-MORE.
000731 READ INVENTORY-FILE-IN AT END GO TO TERMINATE-PROGRAM.
000732 MOVE SPACES TO INV-LINE-OUT.
000733 MOVE CORR INV-RECORD-IN TO INV-LINE-OUT.
000734 MOVE CORR INV-RECORD-IN TO INV-INDEX-OUT
000735***************** CALCULATE TOTALS ********************************************
000736 MULTIPLY ONHAND IN INVENTORY-RECORD-IN BY UNITCOST IN INVENTORY-RECORD-IN
000737 GIVING WORK-AREA.
000738 MOVE WORK-AREA TO TOTALCOST IN INVENTORY-RECORD-OUT.
000739 ADD WORK-AREA TO PAGE-TOTALCOST.
000740 ADD WORK-AREA TO FINAL-TOTALCOST.
000741 MULTIPLY ONHAND IN INVENTORY-RECORD-IN BY UNITSELL IN INVENTORY-RECORD-IN
000742 GIVING WORK-AREA.
000743 MOVE WORK-AREA TO TOTALSELL.
000744 ADD WORK-AREA TO PAGE-TOTALSELL.
000745 ADD WORK-AREA TO FINAL-TOTALSELL.
000746***************** CALCULATE ORDER AMOUNT & PERCENT ****************************
000747 ADD ONHAND IN INVENTORY-RECORD-IN TO ONORDER IN INVENTORY-RECORD-IN
000748 GIVING WORK-AREA.
000749 MOVE ORDERPOINT IN INVENTORY-RECORD-IN TO AMOUNT-TO-ORDER.
000750 SUBTRACT WORK-AREA FROM AMOUNT-TO-ORDER.
000751 MULTIPLY WORK-AREA BY 100 GIVING WORK-AREA.
000752 DIVIDE WORK-AREA BY ORDERPOINT IN INVENTORY-RECORD-IN GIVING PERCENT ROUNDED.
000753 IF (PERCENT <= 50) THEN
000756 MOVE AMOUNT-TO-ORDER TO ORDERAMOUNT IN INVENTORY-RECORD-OUT
000757 ELSE
000758 MOVE ZEROS TO ORDERAMOUNT IN INVENTORY-RECORD-OUT
000759 END-IF.
000760******************* CALCULATE THE PROFIT RATIO ********************************
000761 DIVIDE UNITSELL IN INVENTORY-RECORD-IN BY
000762 UNITCOST IN INVENTORY-RECORD-IN GIVING PROFIT-RATIO ROUNDED.
000763 IF ( PROFIT-RATIO >= +1.32 ) THEN MOVE ZEROS TO PROFIT-RATIO.
000764 MOVE PROFIT-RATIO TO PROFIT-RATIO-OUT.
000765 MOVE "*" TO ASTERISTIC
000766*******************************************************************************
000767 WRITE INVENTORY-INDEX-OUT.
000768 WRITE INVENTORY-RECORD-OUT.
000769 PERFORM INDEX-ERROR.
000770*******************************************************************************
000771 ADD 1 TO LINE-COUNT.
000772 IF (LINE-COUNT > 20) THEN PERFORM NEXT-PAGE.
000773* GO TO TERMINATE-PROGRAM.
000774 GO TO GET-MORE.
000776****************************************************************************
000777* START OF PRINT THE HEADING LINES & BLANK LINE PROCEDURES *
000778****************************************************************************
000779 HEADING-ROUTINE.
000780 MOVE HEADING-RECORD-1 TO LINE-RECORD.
000781 WRITE LINE-RECORD.
000782 MOVE PAGECOUNT TO COUNTER.
000783 ADD 1 TO PAGECOUNT.
000784 MOVE HEADING-RECORD-2 TO LINE-RECORD.
000785 WRITE LINE-RECORD.
000786 MOVE DATE-AREA-EDITED TO LINE-RECORD.
000787 WRITE LINE-RECORD.
000788 MOVE HEADING-RECORD-3 TO LINE-RECORD.
000789 WRITE LINE-RECORD AFTER ADVANCING 2.
000790 PERFORM WRITE-BLANK-LINE.
000791 MOVE HEADING-RECORD-4 TO LINE-RECORD.
000792 WRITE LINE-RECORD BEFORE ADVANCING 1.
000793****************************************************************************
000794* START OF PROCEDURE TO JUST PRINT A SINGLE BLANK LINE *
000795****************************************************************************
000797 WRITE-BLANK-LINE.
000798 MOVE SPACES TO LINE-RECORD.
000799 WRITE LINE-RECORD AFTER ADVANCING 1.
000800****************************************************************************
000801* START OF NEXT PAGE PROCEDURE TO ALLOW FOR LONG REPORTS *
000802****************************************************************************
000803 NEXT-PAGE.
000804 PERFORM PRINT-PAGE-TOTAL-PROC.
000805 MOVE ZEROS TO LINE-COUNT.
000806 PERFORM WRITE-BLANK-LINE.
000807 IF EOF-SWITCH = "N" THEN PERFORM HEADING-ROUTINE.
000808****************************************************************************
000809* START OF PRINT PAGE TOTAL PROCEDURE *
000810****************************************************************************
000811 PRINT-PAGE-TOTAL-PROC.
000812 PERFORM WRITE-BLANK-LINE.
000813 MOVE PAGE-TOTALCOST TO PRINT-PAGE-TOTAL-C.
000814 MOVE ZEROS TO PAGE-TOTALCOST.
000815 MOVE PAGE-TOTALSELL TO PRINT-PAGE-TOTAL-S.
000816 MOVE ZEROS TO PAGE-TOTALSELL.
000817 MOVE PRINT-PAGE-TOTALS TO LINE-RECORD.
000818 WRITE LINE-RECORD.
000819****************************************************************************
000820* INDEX FILE ERROR REPORTING ROUTINE *
000821****************************************************************************
000822 INDEX-ERROR.
000823 IF INDEX-FEED-BACK IS NOT EQUAL TO 00
000824 MOVE SPACES TO LINE-RECORD
000825 MOVE "INDEX FILE OPERATION NOT COMPLETED CODE =" TO ERROR-MESSAGE
000826 MOVE INDEX-FEED-BACK TO ERROR-CODE
000827 MOVE INDEX-ERROR-REC TO LINE-RECORD
000828 WRITE LINE-RECORD.
000829****************************************************************************
000830* START OF CLOSE THE FILES AND END THE PROGRAM PROCEDURE *
000831****************************************************************************
000832 TERMINATE-PROGRAM.
000833 MOVE "Y" TO EOF-SWITCH.
000834 PERFORM NEXT-PAGE.
000835 WRITE LINE-RECORD AFTER ADVANCING 1.
000836 PERFORM WRITE-BLANK-LINE.
000837 MOVE FINAL-TOTALCOST TO PRINT-FINAL-TOTAL-C.
000838 MOVE FINAL-TOTALSELL TO PRINT-FINAL-TOTAL-S.
000839 MOVE PRINT-FINAL-TOTALS TO LINE-RECORD.
000840 WRITE LINE-RECORD AFTER ADVANCING 1.
000841 CLOSE INVENTORY-LISTING-OUT.
000842 CLOSE INVENTORY-LOAD-OUT.
000843 CLOSE INVENTORY-FILE-IN.
000844 END PROGRAM INV-LOAD.
Select what you like and discard the rest.
000010****************************************************************************
000011* START OF THE IDENTIFICATION DIVISION *
000012****************************************************************************
000013 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. INV-LOAD.
000030****************************************************************************
000031* START OF THE ENVIRONMENT DIVISION *
000032****************************************************************************
000040 ENVIRONMENT DIVISION.
000050 CONFIGURATION SECTION.
000051 SPECIAL-NAMES.
000052 PRINTING MODE CHAR-TYPE IS
000053 FOR ALL
000055 IN SIZE 6 POINT
000057 AT PITCH 13
000058 WITH FONT GOTHIC
000059 AT ANGLE 0 DEGREES
000060 BY FORM F0202.
000061 INPUT-OUTPUT SECTION.
000062 FILE-CONTROL.
000070 SELECT INVENTORY-FILE-IN
000080 ASSIGN TO "C:\COBOL\INV_SRT.TXT"
000090 ORGANIZATION IS LINE SEQUENTIAL.
000100 SELECT INVENTORY-LISTING-OUT
000110 ASSIGN TO PRINTER
000120 ORGANIZATION IS SEQUENTIAL.
000130 SELECT INVENTORY-LOAD-OUT
000131 ASSIGN TO "C:\COBOL\INV_INDX.TXT"
000132 ACCESS MODE IS SEQUENTIAL
000133 ORGANIZATION IS INDEXED
000134 RECORD KEY IS ITEM IN INVENTORY-INDEX-OUT
000135 FILE STATUS IS INDEX-FEED-BACK.
000136****************************************************************************
000137* START OF THE DATA DIVISION *
000138****************************************************************************
000140 DATA DIVISION.
000150 FILE SECTION.
000160 FD INVENTORY-FILE-IN.
000170 01 INVENTORY-RECORD-IN.
000180 02 INV-RECORD-IN.
000190 03 ITEM PIC X(6).
000200 03 DESCRIPTION PIC X(20).
000210 03 UNITCOST PIC 99V99.
000211 03 UNITSELL PIC 99V99.
000212 03 ONHAND PIC 9(4).
000220 03 ONORDER PIC 9(4).
000230 03 ORDERPOINT PIC 9(4).
000280 03 FILLER PIC X(34).
000281 FD INVENTORY-LOAD-OUT.
000282 01 INVENTORY-INDEX-OUT.
000283 02 INV-INDEX-OUT.
000284 03 ITEM PIC X(6).
000285 03 DESCRIPTION PIC X(20).
000286 03 UNITCOST PIC 99V99.
000287 03 UNITSELL PIC 99V99.
000288 03 ONHAND PIC 9(4).
000289 03 ONORDER PIC 9(4).
000290 03 ORDERPOINT PIC 9(4).
000291 03 FILLER PIC X(34).
000292
000293 FD INVENTORY-LISTING-OUT.
000294 01 INVENTORY-RECORD-OUT CHARACTER TYPE CHAR-TYPE.
000300 02 INV-LINE-OUT.
000310 03 ITEM PIC X(6).
000320 03 FILLER PIC X.
000330 03 DESCRIPTION PIC X(19).
000340 03 FILLER PIC X.
000350 03 ONHAND PIC Z(4).
000360 03 FILLER PIC X(2).
000370 03 ONORDER PIC Z(4).
000380 03 FILLER PIC XX.
000390 03 ORDERPOINT PIC Z(4).
000400 03 FILLER PIC Z.
000410 03 UNITCOST PIC Z9.99.
000420 03 FILLER PIC X.
000430 03 UNITSELL PIC Z9.99.
000440 03 FILLER PIC X.
000450 03 TOTALCOST PIC $$$$,$$9.99.
000460 03 FILLER PIC XXX.
000470 03 TOTALSELL PIC $$$$,$$9.99.
000480 03 FILLER PIC XX.
000490 03 ORDERAMOUNT PIC Z(4).
000500 03 FILLER PIC XXX.
000510 03 PROFIT-RATIO-OUT PIC Z.ZZ.
000520 03 FILLER PIC X.
000530 03 ASTERISTIC PIC X.
000584 01 LINE-RECORD CHARACTER TYPE CHAR-TYPE.
000585 03 FILLER PIC X(132).
000593****************************************************************************
000594* BEGINNING OF THE WORKING STORAGE SECTION *
000595****************************************************************************
000596 WORKING-STORAGE SECTION.
000597 01 HEADING-RECORD-1.
000598 03 PIC X(42) VALUE SPACES.
000599 03 PIC X(16) VALUE "SPARKS CORP.".
000600 03 PIC X(22) VALUE SPACES.
000601 01 HEADING-RECORD-2.
000602 03 PIC X(37) VALUE SPACES.
000603 03 PIC X(22) VALUE "INVENTORY LOAD REPORT".
000604 03 PIC X(31) VALUE SPACES.
000605 03 PIC X(6) VALUE "PAGE ".
000606 03 COUNTER PIC 99.
000607 01 HEADING-RECORD-3.
000608 03 PIC X(20) VALUE " PART PART ".
000609 03 PIC X(20) VALUE " ON ON OR".
000610 03 PIC X(20) VALUE "DER UNIT UNIT ".
000611 03 PIC X(23) VALUE " TOTAL TOTAL ".
000612 03 PIC X(14) VALUE "ORDER PROFIT ".
000613 01 HEADING-RECORD-4.
000614 03 PIC X(20) VALUE " NO DESCRIPTION ".
000615 03 PIC X(20) VALUE " HAND ORDER PO".
000616 03 PIC X(20) VALUE "INT COST SELL ".
000617 03 PIC X(23) VALUE " COST SELL ".
000618 03 PIC X(14) VALUE " AMT RATIO ".
000619 01 INDEX-ERROR-REC.
000620 03 ERROR-MESSAGE PIC X(43).
000621 03 ERROR-CODE PIC X(2).
000622 01 PRINT-PAGE-TOTALS.
000623 03 FILLER PIC X(42) VALUE SPACES.
000624 03 PIC X(12) VALUE "PAGE TOTALS ".
000625 03 PRINT-PAGE-TOTAL-C PIC $$,$$$,$$9.99.
000626 03 FILLER PIC X VALUE " ".
000627 03 PRINT-PAGE-TOTAL-S PIC $$,$$$,$$9.99.
000628 01 PRINT-FINAL-TOTALS.
000629 03 FILLER PIC X(42) VALUE SPACES.
000630 03 PIC X(12) VALUE "FINAL TOTALS".
000631 03 PRINT-FINAL-TOTAL-C PIC $$,$$$,$$9.99.
000632 03 FILLER PIC X VALUE " ".
000633 03 PRINT-FINAL-TOTAL-S PIC $$,$$$,$$9.99.
000665 01 DATE-AREA.
000666 03 YEAR PIC 9999.
000667 03 MONTH PIC 99.
000668 03 WEEK-DAY PIC 99.
000669 03 HOUR PIC 99.
000670 03 MINUTES PIC 99.
000671 03 SECONDS PIC 99.
000672 03 PARTIALSECONDS PIC 99.
000673 03 DATE-SIGN PIC X.
000674 03 EXTRA PIC 9999.
000675 01 DATE-AREA-EDITED.
000676 03 FILLER PIC X(33) VALUE SPACES.
000677 03 MONTH PIC 99.
000678 03 FILLER PIC X VALUE "/".
000679 03 WEEK-DAY PIC 99.
000680 03 FILLER PIC X VALUE "/".
000681 03 YEAR PIC 9999.
000682 03 FILLER PIC XXX VALUE " ".
000683 03 HOUR PIC 99.
000684 03 FILLER PIC X VALUE ":".
000685 03 MINUTES PIC 99.
000686 03 FILLER PIC X VALUE ":".
000687 03 SECONDS PIC 99.
000688 03 FILLER PIC X VALUE ":".
000689 03 PARTIALSECONDS PIC 99.
000690 03 FILLER PIC XXX VALUE " ".
000691 03 DATE-SIGN PIC X.
000692 03 EXTRA PIC 9999.
000693 01 PAGE-TOTALCOST PIC S999999V99 COMPUTATIONAL.
000694 01 PAGE-TOTALSELL PIC S999999V99 COMPUTATIONAL.
000695 01 FINAL-TOTALCOST PIC S9999999V99 COMPUTATIONAL.
000696 01 FINAL-TOTALSELL PIC S9999999V99 COMPUTATIONAL.
000697 01 PERCENT PIC 99V9 COMPUTATIONAL.
000698 01 PROFIT-RATIO PIC 999V99 COMPUTATIONAL.
000699 01 WORK-AREA PIC S99999999V999 COMPUTATIONAL.
000700 01 AMOUNT-TO-ORDER PIC S9999 COMPUTATIONAL.
000701 01 ONEHALF PIC 99 VALUE 50.
000702 01 PAGECOUNT PIC 99 VALUE 1 COMPUTATIONAL.
000703 01 LINE-COUNT PIC 99 VALUE 0 COMPUTATIONAL.
000704 01 EOF-SWITCH PIC X VALUE "N".
000705 01 INDEX-FEED-BACK PIC XX VALUE IS SPACES.
000706****************************************************************************
000707* START OF THE PROCEDURE DIVISION *
000708****************************************************************************
000709 PROCEDURE DIVISION.
000710****************************************************************************
000711* START OF HOUSEKEEPING PROCEDURE *
000712****************************************************************************
000713 HOUSEKEEPING.
000714 OPEN INPUT INVENTORY-FILE-IN.
000715 OPEN OUTPUT INVENTORY-LOAD-OUT.
000716 OPEN OUTPUT INVENTORY-LISTING-OUT.
000717 MOVE FUNCTION CURRENT-DATE TO DATE-AREA.
000718 MOVE CORR DATE-AREA TO DATE-AREA-EDITED.
000726 PERFORM HEADING-ROUTINE.
000727****************************************************************************
000728* START OF ROUTINE TO READ THE RECORDS AND PROCESS THEM, PROCEDURE *
000729****************************************************************************
000730 GET-MORE.
000731 READ INVENTORY-FILE-IN AT END GO TO TERMINATE-PROGRAM.
000732 MOVE SPACES TO INV-LINE-OUT.
000733 MOVE CORR INV-RECORD-IN TO INV-LINE-OUT.
000734 MOVE CORR INV-RECORD-IN TO INV-INDEX-OUT
000735***************** CALCULATE TOTALS ********************************************
000736 MULTIPLY ONHAND IN INVENTORY-RECORD-IN BY UNITCOST IN INVENTORY-RECORD-IN
000737 GIVING WORK-AREA.
000738 MOVE WORK-AREA TO TOTALCOST IN INVENTORY-RECORD-OUT.
000739 ADD WORK-AREA TO PAGE-TOTALCOST.
000740 ADD WORK-AREA TO FINAL-TOTALCOST.
000741 MULTIPLY ONHAND IN INVENTORY-RECORD-IN BY UNITSELL IN INVENTORY-RECORD-IN
000742 GIVING WORK-AREA.
000743 MOVE WORK-AREA TO TOTALSELL.
000744 ADD WORK-AREA TO PAGE-TOTALSELL.
000745 ADD WORK-AREA TO FINAL-TOTALSELL.
000746***************** CALCULATE ORDER AMOUNT & PERCENT ****************************
000747 ADD ONHAND IN INVENTORY-RECORD-IN TO ONORDER IN INVENTORY-RECORD-IN
000748 GIVING WORK-AREA.
000749 MOVE ORDERPOINT IN INVENTORY-RECORD-IN TO AMOUNT-TO-ORDER.
000750 SUBTRACT WORK-AREA FROM AMOUNT-TO-ORDER.
000751 MULTIPLY WORK-AREA BY 100 GIVING WORK-AREA.
000752 DIVIDE WORK-AREA BY ORDERPOINT IN INVENTORY-RECORD-IN GIVING PERCENT ROUNDED.
000753 IF (PERCENT <= 50) THEN
000756 MOVE AMOUNT-TO-ORDER TO ORDERAMOUNT IN INVENTORY-RECORD-OUT
000757 ELSE
000758 MOVE ZEROS TO ORDERAMOUNT IN INVENTORY-RECORD-OUT
000759 END-IF.
000760******************* CALCULATE THE PROFIT RATIO ********************************
000761 DIVIDE UNITSELL IN INVENTORY-RECORD-IN BY
000762 UNITCOST IN INVENTORY-RECORD-IN GIVING PROFIT-RATIO ROUNDED.
000763 IF ( PROFIT-RATIO >= +1.32 ) THEN MOVE ZEROS TO PROFIT-RATIO.
000764 MOVE PROFIT-RATIO TO PROFIT-RATIO-OUT.
000765 MOVE "*" TO ASTERISTIC
000766*******************************************************************************
000767 WRITE INVENTORY-INDEX-OUT.
000768 WRITE INVENTORY-RECORD-OUT.
000769 PERFORM INDEX-ERROR.
000770*******************************************************************************
000771 ADD 1 TO LINE-COUNT.
000772 IF (LINE-COUNT > 20) THEN PERFORM NEXT-PAGE.
000773* GO TO TERMINATE-PROGRAM.
000774 GO TO GET-MORE.
000776****************************************************************************
000777* START OF PRINT THE HEADING LINES & BLANK LINE PROCEDURES *
000778****************************************************************************
000779 HEADING-ROUTINE.
000780 MOVE HEADING-RECORD-1 TO LINE-RECORD.
000781 WRITE LINE-RECORD.
000782 MOVE PAGECOUNT TO COUNTER.
000783 ADD 1 TO PAGECOUNT.
000784 MOVE HEADING-RECORD-2 TO LINE-RECORD.
000785 WRITE LINE-RECORD.
000786 MOVE DATE-AREA-EDITED TO LINE-RECORD.
000787 WRITE LINE-RECORD.
000788 MOVE HEADING-RECORD-3 TO LINE-RECORD.
000789 WRITE LINE-RECORD AFTER ADVANCING 2.
000790 PERFORM WRITE-BLANK-LINE.
000791 MOVE HEADING-RECORD-4 TO LINE-RECORD.
000792 WRITE LINE-RECORD BEFORE ADVANCING 1.
000793****************************************************************************
000794* START OF PROCEDURE TO JUST PRINT A SINGLE BLANK LINE *
000795****************************************************************************
000797 WRITE-BLANK-LINE.
000798 MOVE SPACES TO LINE-RECORD.
000799 WRITE LINE-RECORD AFTER ADVANCING 1.
000800****************************************************************************
000801* START OF NEXT PAGE PROCEDURE TO ALLOW FOR LONG REPORTS *
000802****************************************************************************
000803 NEXT-PAGE.
000804 PERFORM PRINT-PAGE-TOTAL-PROC.
000805 MOVE ZEROS TO LINE-COUNT.
000806 PERFORM WRITE-BLANK-LINE.
000807 IF EOF-SWITCH = "N" THEN PERFORM HEADING-ROUTINE.
000808****************************************************************************
000809* START OF PRINT PAGE TOTAL PROCEDURE *
000810****************************************************************************
000811 PRINT-PAGE-TOTAL-PROC.
000812 PERFORM WRITE-BLANK-LINE.
000813 MOVE PAGE-TOTALCOST TO PRINT-PAGE-TOTAL-C.
000814 MOVE ZEROS TO PAGE-TOTALCOST.
000815 MOVE PAGE-TOTALSELL TO PRINT-PAGE-TOTAL-S.
000816 MOVE ZEROS TO PAGE-TOTALSELL.
000817 MOVE PRINT-PAGE-TOTALS TO LINE-RECORD.
000818 WRITE LINE-RECORD.
000819****************************************************************************
000820* INDEX FILE ERROR REPORTING ROUTINE *
000821****************************************************************************
000822 INDEX-ERROR.
000823 IF INDEX-FEED-BACK IS NOT EQUAL TO 00
000824 MOVE SPACES TO LINE-RECORD
000825 MOVE "INDEX FILE OPERATION NOT COMPLETED CODE =" TO ERROR-MESSAGE
000826 MOVE INDEX-FEED-BACK TO ERROR-CODE
000827 MOVE INDEX-ERROR-REC TO LINE-RECORD
000828 WRITE LINE-RECORD.
000829****************************************************************************
000830* START OF CLOSE THE FILES AND END THE PROGRAM PROCEDURE *
000831****************************************************************************
000832 TERMINATE-PROGRAM.
000833 MOVE "Y" TO EOF-SWITCH.
000834 PERFORM NEXT-PAGE.
000835 WRITE LINE-RECORD AFTER ADVANCING 1.
000836 PERFORM WRITE-BLANK-LINE.
000837 MOVE FINAL-TOTALCOST TO PRINT-FINAL-TOTAL-C.
000838 MOVE FINAL-TOTALSELL TO PRINT-FINAL-TOTAL-S.
000839 MOVE PRINT-FINAL-TOTALS TO LINE-RECORD.
000840 WRITE LINE-RECORD AFTER ADVANCING 1.
000841 CLOSE INVENTORY-LISTING-OUT.
000842 CLOSE INVENTORY-LOAD-OUT.
000843 CLOSE INVENTORY-FILE-IN.
000844 END PROGRAM INV-LOAD.
All COBOL Data is TEXT (More or less).
In some file systems like VSAM there are control fields that add some length to the field, but you dont really define them except when you set up the file (Indirectly).
When I extract files I make an SD Build File with no keys and convert all fields to straight alphanumeric values. If it has Packed field they are unpacked into decimal and stored as alphanumberic. It really depends what kind of files you are dealing with and how many types of fields you have. I have some files with both COMP and COMP-3 Fields. There are some products that may do this for you like EZ Trieve or Decision Analyzer.
Hopefully you dont have occurs within occurs that are better broke down into multiple files.
If you do not like my post feel free to point out your opinion or my errors.
In some file systems like VSAM there are control fields that add some length to the field, but you dont really define them except when you set up the file (Indirectly).
When I extract files I make an SD Build File with no keys and convert all fields to straight alphanumeric values. If it has Packed field they are unpacked into decimal and stored as alphanumberic. It really depends what kind of files you are dealing with and how many types of fields you have. I have some files with both COMP and COMP-3 Fields. There are some products that may do this for you like EZ Trieve or Decision Analyzer.
Hopefully you dont have occurs within occurs that are better broke down into multiple files.
If you do not like my post feel free to point out your opinion or my errors.
- Status
Similar threads
- Locked
- Question