<<< Výpis tiskové banky - verze 1
IDENTIFICATION DIVISION.
PROGRAM-ID. P90003.
AUTHOR. ING CEVELA.
INSTALLATION.
TESLA 200
- POCETNICKA SLUZBA BRNO.
DATE-WRITTEN. MAY 70.
DATE-COMPILED. 3 JUN 1970.
REMARKS.
VYPIS TISKOVE BANKY DO STANDARDNICH SESTAV - VERSE 1.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
FILE-CONTROL.
SELECT T-B ASSIGN TAPE CODE ".3".
SELECT TISKARNA ASSIGN PRINTER CODE "*3".
DATA DIVISION.
FILE SECTION.
FD T-B
LABEL RECORD STANDARD
VALUE OF ID "TISKOVA BANKA "
DATA RECORD ZAZNAM.
01 ZAZNAM.
02 ID1 PIC X.
02 ID2 PIC X.
02 RADEK PIC X(136).
FD TISKARNA
LABEL RECORD OMITTED
DATA RECORD TISK.
01 TISK PIC X(136).
WORKING-STORAGE SECTION.
77 W0 PIC 9 VALUE 0.
77 W1 PIC 9 VALUE 0.
77 W2 PIC 9 VALUE 0.
77 W3 PIC 9 VALUE 0.
77 W4 PIC 9 VALUE 0.
01 POM.
02 ROP PIC 99 COMPUTATIONAL-1.
02 OPOM PIC 99 cOMPUTATIONAL-1.
02 TEST PIC 9.
02 PCR PIC 99 VALUE 0.
01 SEST.
02 ID.
03 1-1 PIC X.
03 1-2 PIC 9.
02 RL PIC 9.
02 RM PIC 9.
02 RO PIC 99 COMPUTATIONAL-1.
02 CISLO PIC X(6).
02 DAT-PL PIC 9(8).
02 NAZEV-1 PIC X(39).
02 NAZEC-2 PIC X(39).
01 ID2G1 PIC 9.
01 LEG-1 PIC X(136).
01 ID2G2 PIC 9.
01 LEG-2 PIC X(136).
01 ID2G3 PIC 9.
01 LEG-3 PIC X(136).
01 Z1.
02 FILLER PIC X(114).
02 TE PIC X(10) VALUE "STRANKA : ".
02 STR PIC 999.
02 FILLER PIC X(9).
01 Z2.
02 FILLER PIC X(9).
02 T-1 PIC X(23) VALUE "INGSTAV BRNO - SESTAVA ".
02 C-S PIC X(6).
02 FILLER PIC X.
02 N-1 PIC X(39).
02 FILLER PIC X(6).
02 T-2 PIC X(18) VALUE "DATUM PLATNOSTI : ".
02 D-1 PIC 9(8).
02 FILLER PIC X(4).
01 Z3.
02 FILLER PIC X(39).
02 N-2 PIC X(39).
01 Z-0.
02 CO PIC X(6) VALUE ZERO.
02 N10 PIC X(39) VALUE ZERO
02 N20 PIC X(39) VALUE ZERO
02 STR-SO PIC 999 VALUE 0.
01 Z-1.
02 C1 PIC X(6).
02 N11 PIC X(39).
02 N21 PIC X(39).
02 STR-S1 PIC 999 VALUE O.
01 Z-2.
02 C2 PIC X(6).
02 N12 PIC X(39).
02 N22 PIC X(39).
02 STR-S2 PIC 999 VALUE O.
01 Z-3.
02 C3 PIC X(6).
02 N13 PIC X(39).
02 N23 PIC X(39).
02 STR-S3 PIC 999 VALUE O.
01 TEXT PIC X(25) VALUE "VYTISTENA SESTAVA CISLO ".
01 TEXT1 PIC X(9) VALUE "OBSAHUJE ".
01 TEXT2 PIC X(8) VALUE " STRAN .".
01 ST PIC X(25) VALUE "ON PRESENTE TISK STANDARD".
01 SC.
02 FILLER PIC X.
02 STR-C PIC 9999 VALUE 0.
02 TC PIC X(23) VALUE " STRAN. CA Y EST TOUT !".
01 INF0 PIC X(12) VALUE "ID1 NEZNAM :".
01 INF1 PIC X(32) VALUE "POZADOVANY POCET SESTAV V 50BC :".
01 INF2 PIC X(32) VALUE "POZADOVANY POCET RADKU LEGENDY :".
01 INF3 PIC X(28) VALUE "RADEK LEGENDY NAVIC (CTVRTY)".
01 INF4 PIC X(27) VALUE "POSLEDNI SESTAVA NEMA RADKY".
01 DOTAZ PIC X(21) VALUE "JE MOZNO POKRACOVAT ?".
01 ODP PIC X.
PROCEDURE DIVISION.
BEGIN. OPEN INPUT T-B OUTPUT TISKARNA.
ONE. READ T-B
AT END GO TO T-NINE.
IF ID1 # "R" GO TO THREE.
MOVE 0 TO ROP.
NINE. IF WO # 0 GO TO FIVE.
IF ID1 = "L" GO TO FIVE.
ADD ID2 TO PCR
IF PCR > 67 GO TO FIVE.
SUBTRACT R0P FROM 67 GIVING OPOM
IF PCR > 0P0M GO TO T-THREE.
TWELVE.
MOVE 1 TO W4
IF W0 # 0 GO TO THIRTY.
TWO. DISPLAY TEXT, C0
DISPLAY N10
DISPLAY N20
DISPLAY TEXT1, STR-S0, TEXT2
IF STR-S1 = 0 GO TO SIX.
DISPLAY TEXT, C1
DISPLAY N11
DISPLAY N21
DISPLAY TEXT1, STR-S1, TEXT2
IF STR-S2 = 0 GO TO SIX.
DISPLAY TEXT, C2
DISPLAY N12
DISPLAY N22
DISPLAY TEXT1, STR-S2, TEXT2
IF STR-S3 = 0 GO TO SIX.
DISPLAY TEXT, C3
DISPLAY N13
DISPLAY N23
DISPLAY TEXT1, STR-S3, TEXT2
SIX.
MOVE ZEROS TO STR-S0, STR-S1, STR-S2, STR-S3
IF W4 # 1 GO TO SEVEN.
DISPLAY DATE-Y, DATE-M, DATE-DM, SC.
FIN. CLOSE T-B, TISKARNA.
STOP RUN.
THIRTY.
DISPLAY 1NF4
DISPLAY SEST
GO TO TWO.
THREE. IF ID1 # "0" GO TO T-TWO.
MOVE R0 TO R0P
GO TO NINE.
T-TWO. IF ID1 # "L" GO TO EIGHT.
GO TO NINE.
EIGHT.
IF ID1 # "S" GO TO E-TEEN.
MOVE ID2 TO TEST
MOVE ZAZNAM TO SEST
MOVE 0 TO W1, W2, W3.
TWENTY. MOVE 1 TO W0
GO TO ONE.
E-TEEN. IF ID1 # "G" GO TO T-FIVE.
IF W1 = 1 GO TO N-TEEN.
MOVE 1D2 TO ID2G1
MOVE RADEK TO LEG-1
MOVE 1 TO W1
GO TO TWENTY.
T-FIVE.
DISPLAY INFO, 1D1
DISPLAY CISLO
GO TO SI-TEEN.
N-TEEN. IF W2 = 1 GO TO T-ONE.
MOVE ID2 TO ID2G2
MOVE RADEK TO LEG-2
MOVE1 TO W3.
GO TO TWENTY.
T-SIX.
DISPLAY INF3
DISPLAY CISLO
GO TO SI-TEEN.
FIVE. IF TEST # 0 GO TO TEN.
IF CO = ZERO GO TO T-FOR.
IF CISLO # CO GO TO TWO.
SEVEN.
ADD STR-S0, 1 GIVING STR. STR-S0
MOVE CISLO TO CO, C-S
MOVE NAZEV-1 TO N10, N-1
MOVE NAZEV-2 TO N20, N-2
FO-TEEN. MOVE DAT-PL TO D-1
MOVE DAT-PRED TO D-2.
MOVE SPACES TO TISK
WRITE TISK AFTER L
WRITE TISK FROM Z1 AFTER 4 LINES
WRITE TISK FROM Z2
WRITE TISK FROM Z3.
MOVE 6 TO PCR
IF RL < 1 GO TO SE-TEEN,
ELEVEN. WRITE TISK FROM LEG-1 AFTER ID2G1 LINES
ADD ID2G1 TO PCR
IF RL < 2 GO TO SE-TEEN.
WRITE TISK FROM LEG-2 AFTER ADVANCING ID2G2 LINES
ADD ID2G2 TO PCR
IF RL < 3 GO TO SE-TEEN.
WRITE TISK FROM LEG-3 AFTER ADVANCING ID2G3 LINES
ADD ID2G3 TO PCR
IF RL < 4 GO TO SE-TEEN.
DISPLAY INF2, RL
DISPLAY SEST.
T-EIGHT.
DISPLAY DOTAZ
ACCEPT ODP
IF ODP # "A" GO TO FIN.
GO TO ONE.
TEN. IF TEST # 1 GO TO T-TEEN.
ADD STR-S1, 1 GIVING STR, STR-S1
MOVE CISLO TO C1, C-S
MOVE NAZEV-1 TO N11, N-1
MOVE NAZEV-2 TO N21, N-2
GO TO FO-TEEN.
T-TEEN. IF TEST # 2 GO TO T-SEVEN.
ADD STR-S2, 1 GIVING STR, STR-S2
MOVE CISLO TO C2, C-S
MOVE NAZEV-1 TO N12, N-1
MOVE NAZEV-2 TO N22, N-2
GO TO FO-TEEN.
FI-TEEN. IF TEST # 3 GO TO T-SEVEN.
ADD STR-S3, 1 GIVING STR, STR-S3
MOVE CISLO TO C3, C-S
MOVE NAZEV-1 TO N13, N-1
MOVE NAZEV-2 TO N23, N-2
GO TO FO-TEEN.
T-SEVEN.
DISPLAY INF1, TEST
DISPLAY CISLO.
SI-TEEN.
DISPLAY ZAZNAM
GO TO T-EIGHT.
T-FOR.
DISPLAY ST
GO TO SEVEN.
SE-TEEN.
ADD 1 TO STR-C.
MOVE SPACES TO TISK
WRITE TISK AFTER RM LINES
MOVE 0 TO W0
ADD RM TO PCR
ADD ID2 TO PCR
GO TO TWELVE.
T-THREE.
MOVE 0 TO R0P
GO TO FIVE.