<<<  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.