API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 7th, 2017
61
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 8.85 KB | None | 0 0
raw download clone embed print report
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID. STA0007B.
  3.        AUTHOR. MAZZAROLO MATTEO.
  4.        DATE-WRITTEN. 2010-12-20
  5.  
  6.        ENVIRONMENT DIVISION.
  7.  
  8.        INPUT-OUTPUT SECTION.
  9.  
  10.        FILE-CONTROL.
  11.        SELECT FILEPLI       ASSIGN TO FILEPLI.
  12.        SELECT FILECON       ASSIGN TO FILECON.
  13.        SELECT FILEDES       ASSIGN TO FILEDES.
  14.        SELECT FILESTA       ASSIGN TO FILESTA.
  15.  
  16.        DATA DIVISION.
  17.  
  18.        FILE SECTION.
  19.  
  20.        FD FILEPLI    LABEL RECORD IS STANDARD.
  21.        01 REC-FILE-PLI-2001               PIC X(50).
  22.  
  23.        FD FILECON    LABEL RECORD IS STANDARD.
  24.        01 REC-FILE-PLI-CONTIGUI           PIC X(50).
  25.  
  26.        FD FILEFIL    LABEL RECORD IS STANDARD.
  27.        01 REC-FILE-DIP-DESCR              PIC X(50).
  28.  
  29.        FD FILEREP     LABEL RECORD IS STANDARD.
  30.        01 REC-FILE-STAMPA                 PIC X(200).
  31.  
  32.        WORKING-STORAGE SECTION.
  33.  
  34.        01 NOME-PGM                        PIC X(08) VALUE 'STA0007B'.
  35.  
  36.       * TRACCIATO FILE-2001 *
  37.        01 W-REC-FILE-PLI-2001.
  38.          03 W-DIP-2001                    PIC 9(05).
  39.          03 W-NUM-PLI-2001                    PIC 9(12).
  40.          03 W-COSTO-2001                  PIC 9(7)V99.
  41.  
  42.       * TRACCIATO FILE-CONTIGUI *
  43.        01 W-REC-FILE-PLI-CONTIGUI.
  44.          03 W-DIP-PLI-CONTIGUI                PIC 9(05).
  45.          03 W-NUM-PLI-CONTIGUI                PIC 9(12).
  46.  
  47.       * TRACCIATO FILE-DESCR *
  48.        01 W-REC-FILE-DIP-DESCR.
  49.          03 W-NUM-DESCR                     PIC 9(05).
  50.          03 W-DESCR-DESCR                   PIC X(30).
  51.  
  52.       * RECORD INTESTAZIONE PAGINA *
  53.        01 W-REC-INT-PAG.
  54.          03 FILLER                        PIC X.
  55.          03 FILLER                        PIC X(06) VALUE 'DATA: '.
  56.          03 W-DATA-ST                     PIC X(10).
  57.          03 FILLER                        PIC X(93) VALUE SPACES.
  58.          03 FILLER                        PIC X(08) VALUE 'PAGINA: '.
  59.          03 W-PAGINA-ST                   PIC Z(06)9.
  60.  
  61.       * RECORD INTESTAZIONE CODICE DELLA DIPENDENZA *
  62.        01 W-REC-INT-DIPENDENZA.
  63.          03 FILLER                        PIC X.
  64.          03 FILLER                        PIC X(12) VALUE 'DIPENDENZA: '
  65.          03 W-COD-DIP-ST                  PIC Z(05)9.
  66.  
  67.       * RECORD DESCRIZIONE DELLA DIPENDENZA *
  68.        01 W-REC-INT-DESCRIZIONE.
  69.          03 FILLER                        PIC X.
  70.          03 FILLER                        PIC X(13) VALUE 'DESCRIZIONE: '
  71.          03 W-DESCR-ST                    PIC X(30).
  72.  
  73.       * RECORD L'INTESTAZIONE DEI PLICHI *
  74.       01 W-REC-INT-PLICHI.
  75.         03 FILLER                        PIC X.
  76.         03 FILLER                        PIC X(12) VALUE '*- NUM PLI -*'.
  77.         03 FILLER                        PIC X(01) VALUE SPACE.
  78.         03 FILLER                        PIC X(11) VALUE '*-- COSTO --*'.
  79.  
  80.      * RECORD I DATI DEI PLICHI *
  81.       01 W-REC-DATI.
  82.         03 FILLER                        PIC X.
  83.         03 W-DATI-NUM-ST                 PIC Z(12)9.
  84.         03 FILLER                        PIC X(01) VALUE SPACE.
  85.         03 W-DATI-COSTO-ST               PIC Z(7)9,99.
  86.  
  87.      * RECORD PER IL COSTO TOTALE DEI PLICHI*
  88.       01 W-REC-COSTO-TOTALE.
  89.         03 FILLER                        PIC X.
  90.         03 FILLER                        PIC X(08) VALUE SPACES.
  91.         03 FILLER                        PIC X(05) VALUE 'TOT: '.
  92.         03 W-COSTO-TOTALE-ST             PIC Z(15)9,99.
  93.  
  94.      * END-OF-FILE *
  95.       01 EOF-FILE-PLI-2001                PIC 9(01) VALUE ZERO.
  96.       01 EOF-FILE-PLI-CONTIGUI          PIC 9(01) VALUE ZERO.
  97.       01 EOF-FILE-DIP-DESCR             PIC 9(01) VALUE ZERO.
  98.  
  99.      * VARIABILI AGGIUNTIVE *
  100.       01 MAX-RIGHE                      PIC 9(06) VALUE 40.
  101.       01 CONT-RIGHE-DATI                PIC 9(06) VALUE ZERO.
  102.       01 CONT-PAGINA                    PIC 9(06) VALUE ZERO.
  103.       01 COSTO-TOTALE                   PIC 9(15),99 VALUE ZERO.
  104.       01 DIP-ATTUALE                    PIC 9(06) VALUE ZERO.
  105.  
  106.      * SKEDA-PARAMETRO *
  107.       01 SKEDA-PARAMETRO.
  108.         03 SK-DATA-OGGI                 PIC X(10).
  109.  
  110.       PROCEDURE DIVISION.
  111.  
  112.      *-----*
  113.       MAIN.
  114.      *-----*
  115.         PERFORM INIZIALIZZA
  116.  
  117.         PERFORM LETTURA-FILEPLI
  118.         PERFORM LETTURA-FILECON
  119.         PERFORM LETTURA-FILEDES
  120.         PERFORM BILANCIAMENTO-DIPENDENZE
  121.           UNTIL EOF-FILE-PLI-2001 = 1
  122.           OR    EOF-FILE-PLI-CONTIGUI = 1
  123.         PERFORM STAMPA-COSTO-TOTALE
  124.  
  125.         PERFORM FINE-PGM
  126.         .
  127.  
  128.      *------------*
  129.       INIZIALIZZA.
  130.      *------------*
  131.         DISPLAY 'INIZIO PGM ' NOME-PGM
  132.         OPEN INPUT  FILEPLI
  133.                     FILECON
  134.                     FILEDES
  135.              OUTPUT FILESTA
  136.  
  137.         ACCEPT SKEDA-PARAMETRO
  138.         .
  139.  
  140.      *-------------------------*
  141.       BILANCIAMENTO-DIPENDENZE.
  142.      *-------------------------*
  143.         EVALUATE TRUE
  144.           WHEN W-DIP-PLI-2001 = W-DIP-PLI-CONTIGUI
  145.             PERFORM BILANCIAMENTO-PLICHI
  146.           WHEN W-DIP-PLI-2001 < W-DIP-PLI-CONTIGUI
  147.             PERFORM LETTURA-FILEPLI
  148.           WHEN W-DIP-PLI-2001 > W-DIP-PLI-CONTIGUI
  149.             PERFORM LETTURA-FILECON
  150.         END-EVALUATE
  151.         .
  152.  
  153.      *---------------------*
  154.       BILANCIAMENTO-PLICHI.
  155.      *---------------------*
  156.         EVALUATE TRUE
  157.           WHEN W-NUM-PLI-2001 = W-NUM-PLI-CONTIGUI
  158.             PERFORM STAMPA-COSTO-TOTALE
  159.             PERFORM STAMPA-INTESTAZIONI
  160.             PERFORM STAMPA-DATI-PLICO
  161.             PERFORM LEGGI-FILEPLI
  162.             PERFORM LEGGI-FILECON
  163.             MOVE W-DIP-PLI-2001 TO DIP-ATTUALE
  164.           WHEN W-NUM-PLI-2001 < W-NUM-PLI-CONTIGUI
  165.             PERFORM LEGGI-FILEPLI
  166.           WHEN W-NUM-PLI-2001 > W-NUM-PLI-CONTIGUI
  167.             PERFORM LEGGI-FILECON
  168.         END-EVALUATE
  169.         .
  170.  
  171.      *--------------------*
  172.       STAMPA-INTESTAZIONI.
  173.      *--------------------*
  174.         IF W-DIP-PLI-2001 NOT = DIP-ATTUALE OR NUM-RIGHE-DATI > MAX-RIGHE
  175.           PERFORM STAMPA-INTESTAZIONE-PAGINA
  176.           PERFORM STAMPA-INTESTAZIONE-DIPENDENZA
  177.         END-IF
  178.         .
  179.  
  180.      *---------------------------*
  181.       STAMPA-INTESTAZIONE-PAGINA.
  182.      *---------------------------*
  183.         ADD 1 TO CONT-PAGINA
  184.         INITIALIZE CONT-RIGHE-DATI
  185.  
  186.         MOVE SK-DATA-OGGI TO W-DATA-ST
  187.         MOVE CONT-PAGINA  TO W-PAG-ST
  188.  
  189.         IF CONT-PAGINA = 1
  190.           WRITE REC-FILE-STAMPA FROM W-REC-INT-PAGINA
  191.         ELSE
  192.           WRITE REC-FILE-STAMPA FROM W-REC-INT-PAGINA AFTER PAGE
  193.         END-IF
  194.         .
  195.  
  196.      *-------------------------------*
  197.       STAMPA-INTESTAZIONE-DIPENDENZA.
  198.      *-------------------------------*
  199.         IF W-NUM-PLI-2001 NOT = DIP-ATTUALE
  200.           MOVE W-DIP-PLI-2001 IN W-COD-DIP-ST
  201.           MOVE 'DESCRIZIONE NON TROVATA' IN W-DESCR-ST
  202.           PERFORM CERCA-DESCRIZIONE
  203.  
  204.           UNTIL W-DIP-DESCR > W-DIP-PLI-2001
  205.           OR    EOF-FILE-DES = 1
  206.  
  207.           WRITE REC-FILE-STAMPA FROM W-REC-INT-DIPENDENZA AFTER 2 LINES
  208.           WRITE REC-FILE-STAMPA FROM W-REC-INT-DESCRIZIONE
  209.           WRITE REC-FILE-STAMPA FROM W-REC-INT-DATI AFTER 2 LINES
  210.         ELSE
  211.           WRITE REC-FILE-STAMPA FROM W-REC-INT-DATI AFTER 5 LINES
  212.         END-IF
  213.         .
  214.  
  215.      *------------------*
  216.       CERCA-DESCRIZIONE.
  217.      *------------------*
  218.         IF W-DIP-DESCR = W-DIP-PLI-2001
  219.           MOVE W-DESCR-DESCR IN W-DESCR-ST
  220.         END-IF
  221.         PERFORM LETTURA-FILEDES
  222.         .
  223.  
  224.      *-------------------*
  225.       STAMPA-DATI-PLICO.
  226.      *-------------------*
  227.         MOVE W-NUM-PLI-2001   TO W-DATI-NUM-ST
  228.         MOVE W-COSTO-PLI-2001 TO W-DATI-COSTO-ST
  229.  
  230.         ADD W-COSTO-PLI-2001  TO COSTO-TOTALE
  231.  
  232.         WRITE REC-FILE-STAMPA FROM W-REC-DATI-PLICHI
  233.         .
  234.  
  235.      *-------------------*
  236.       STAMPA-COSTO-TOTALE.
  237.      *-------------------*
  238.         IF W-DIP-PLI-01 NOT = DIP-ATTUALE OR NUM-RIGHE-DATI > MAX-RIGHE
  239.           MOVE COSTO-TOTALE TO W-COSTO-TOT-ST
  240.           WRITE REC-FILE-STAMPA FROM W-REC-TOTALE
  241.           INITIALIZE COSTO-TOTALE
  242.         END-IF
  243.         .
  244.  
  245.      *----------------*
  246.       LETTURA-FILEPLI.
  247.      *----------------*
  248.         READ FILEPLI INTO W-REC-FILE-PLI-2001
  249.         AT END MOVE 1 TO EOF-FILE-PLI-2001
  250.         .
  251.  
  252.      *----------------*
  253.       LETTURA-FILECON.
  254.      *----------------*
  255.         READ FILECON INTO W-REC-FILE-PLI-CONTIGUI
  256.         AT END MOVE 1 TO EOF-FILE-PLI-CONTIGUI
  257.          .
  258.  
  259.      *----------------*
  260.       LETTURA-FILEDES.
  261.      *----------------*
  262.         READ FILEFIL INTO W-REC-FILE-DESCR
  263.         AT END MOVE 1 TO EOF-FILE-DESCR
  264.         .
  265.  
  266.      *---------*
  267.       FINE-PGM.
  268.      *---------*
  269.         CLOSE FILEPLI
  270.               FILECON
  271.               FILEDES
  272.               FILESTA
  273.         DISPLAY 'FINE PGM' NOME-PGM
  274.         GOBACK
  275.         .
  276. 
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!