|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5248 (0x1480)
Types: TextFile
Names: »STOCK1.LST«
└─⟦1b6e6286b⟧ Bits:30003265 CIS COBOL version 4.4 til CP/M-80 (BG/0000/BL)
└─ ⟦this⟧ »STOCK1.LST«
\f ** CIS COBOL V4.4 STOCK1.CBL PAGE: 0001 ** 000010 IDENTIFICATION DIVISION. 0118 000020 PROGRAM-ID. STOCK-FILE-SET-UP. 0118 000030 AUTHOR. MICRO FOCUS LTD. 0118 000040 ENVIRONMENT DIVISION. 0118 000050 CONFIGURATION SECTION. 0118 000060 SOURCE-COMPUTER. APPLE-II. 0118 000070 OBJECT-COMPUTER. APPLE-II. 0118 000075 SPECIAL-NAMES. CONSOLE IS CRT. 0118 000080 INPUT-OUTPUT SECTION. 0118 000090 FILE-CONTROL. 0118 000100 SELECT STOCK-FILE ASSIGN "STOCK.IT" 0184 000110 ORGANIZATION INDEXED 0186 000120 ACCESS DYNAMIC 0186 000130 RECORD KEY STOCK-CODE. 0186 000140 DATA DIVISION. 01BE 000150 FILE SECTION. 01BE 000160 FD STOCK-FILE; RECORD 32. 01BE 000170 01 STOCK-ITEM. 01BE 000180 02 STOCK-CODE PIC X(4). 01BE 000190 02 PRODUCT-DESC PIC X(20). 01C2 000200 02 UNIT-SIZE PIC 9(4). 01D6 000210 WORKING-STORAGE SECTION. 01DC 000220 01 SCREEN-HEADINGS. 01DC 00 000230 02 ASK-CODE PIC X(21) VALUE "STOCK CODE < >". 01DC 00 000240 02 FILLER PIC X(59). 01F1 15 000250 02 ASK-DESC PIC X(16) VALUE "DESCRIPTION <". 022C 50 000260 02 SI-DESC PIC X(21) VALUE " >". 023C 60 000270 02 FILLER PIC X(43). 0251 75 000280 02 ASK-SIZE PIC X(21) VALUE "UNIT SIZE < >". 027C A0 000290 01 ENTER-IT REDEFINES SCREEN-HEADINGS. 01DC 00 000300 02 FILLER PIC X(16). 01DC 00 000310 02 CRT-STOCK-CODE PIC X(4). 01EC 10 000320 02 FILLER PIC X(76). 01F0 14 000330 02 CRT-PROD-DESC PIC X(20). 023C 60 000340 02 FILLER PIC X(60). 0250 74 000350 02 CRT-UNIT-SIZE PIC 9(4). 028C B0 000360 02 FILLER PIC X. 0290 B4 000370 PROCEDURE DIVISION. 0000 000380 SR1. 001A 00 000390 DISPLAY SPACE. 001B 000400 OPEN I-O STOCK-FILE. 001E 000410 DISPLAY SCREEN-HEADINGS. 0022 000420 NORMAL-INPUT. 0036 00 000430 MOVE SPACE TO ENTER-IT. 0037 000440 DISPLAY ENTER-IT. 003D 000450 CORRECT-ERROR. 0054 00 000460 ACCEPT ENTER-IT. 0055 000470 IF CRT-STOCK-CODE = SPACE GO TO END-IT. 006C 000480 IF CRT-UNIT-SIZE NOT NUMERIC GO TO CORRECT-ERROR. 0076 000490 MOVE CRT-PROD-DESC TO PRODUCT-DESC. 007F 000500 MOVE CRT-UNIT-SIZE TO UNIT-SIZE. 0085 000510 MOVE CRT-STOCK-CODE TO STOCK-CODE. 008D 000520 WRITE STOCK-ITEM; INVALID GO TO CORRECT-ERROR. 0093 000530 GO TO NORMAL-INPUT. 009F 000540 END-IT. 00A2 00 000550 CLOSE STOCK-FILE. 00A3 000560 DISPLAY SPACE. 00A7 000570 DISPLAY "END OF PROGRAM". 00AA \f ** CIS COBOL V4.4 STOCK1.CBL PAGE: 0002 ** 000580 STOP RUN. 00BB ** CIS COBOL V4.4 REVISION 1 URN BG/0000/BL ** COMPILER COPYRIGHT (C) 1978,1981 MICRO FOCUS LTD ** ERRORS=00000 DATA=00657 CODE=00239 DICT=00421:19278/19699 GSA FLAGS= OFF «eof»