API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 7th, 2017
64
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 9.18 KB | None | 0 0
raw download clone embed print report
  1.      IDENTIFICATION DIVISION.
  2.        PROGRAM-ID STA0007B.
  3.        AUTHOR. BORDIN ALEX.
  4.       *-----------------------------------------------
  5.        ENVIRONMENT DIVISION.
  6.        INPUT-OUTPUT SECTION.
  7.        FILE-CONTROL.
  8.            SELECT FILEPAN ASSIGN TO FILEPAN.
  9.            SELECT FILEPAL ASSIGN TO FILEPAL.
  10.            SELECT FILEDES ASSIGN TO FILEDES.
  11.            SELECT FILEREP ASSIGN TO FILEREP.
  12.       *
  13.        DATA DIVISION.
  14.       *
  15.        FILE SECTION.
  16.        FD  FILEPAN
  17.            LABEL RECORD IS STANDARD.
  18.        01  REC-FILE-PAN           PIC X(200).
  19.       *
  20.        FD  FILEPAL
  21.            LABEL RECORD IS STANDARD.
  22.        01  REC-FILE-PAL           PIC X(100).
  23.       *
  24.        FD  FILEBLO
  25.            LABEL RECORD IS STANDARD.
  26.        01  REC-FILE-DES           PIC X(100).
  27.       *
  28.        FD  FILESTA
  29.            LABEL RECORD IS STANDARD.
  30.        01  REC-FILE-STA           PIC X(100).
  31.       *
  32.        WORKING-STORAGE SECTION.
  33.       *
  34.        01  NOME-PGM               PIC X(08) VALUE 'STA0007B'.
  35.  
  36.       *TRACCIATO FILE-PAN
  37.        01  W-REC-FILE-PAN.
  38.            03 W-COD-DIP-PAN       PIC 9(05).
  39.            03 W-NUM-PLI-PAN       PIC 9(12).
  40.            03 W-COSTO-PAN         PIC 9(07)V99.
  41.  
  42.       *TRACCIATO FILE-PAL
  43.        01  W-REC-FILE-PAL.
  44.            03 W-COD-DIP-PAL       PIC 9(05).
  45.            03 W-NUM-PLI-PAL       PIC 9(12).
  46.  
  47.       *TRACCIATO FILE-DES
  48.        01  W-REC-FILE-BLO.
  49.            03 W-COD-DIP-DES       PIC 9(05).
  50.            03 W-DESCR-DES         PIC X(30).
  51.  
  52.       *VARIABILI DI STAMPA
  53.        01  W-REC-DATA-PAG-ST.
  54.            03 FILLER              PIC X.
  55.            03 FILLER              PIC X(06)  VALUE 'DATA: '.
  56.            03 W-REC-DATA-ST       PIC X(10).
  57.            03 FILLER              PIC X(52)  VALUE SPACES.
  58.            03 FILLER              PIC X(05)  VALUE 'PAG: '.
  59.            03 W-REC-PAG-ST        PIC 9(06)  VALUE ZERO.
  60.  
  61.        01  W-REC-DIPENDENZA-ST.
  62.            03 FILLER              PIC X.
  63.            03 FILLER              PIC X(12)  VALUE 'DIPENDENZA: '.
  64.            03 W-REC-DIPENDENZA    PIC 9(05).
  65.  
  66.        01  W-REC-DESCR-ST.
  67.            03 FILLER              PIC X.
  68.            03 FILLER              PIC X(13)  VALUE 'DESCRIZIONE: '.
  69.            03 W-REC-DESCR         PIC X(30).
  70.  
  71.        01  W-REC-INT-COLONNE-ST.
  72.            03 FILLER              PIC X.
  73.            03 FILLER              PIC X(12)  VALUE 'NUMERO PLICO'.
  74.            03 FILLER              PIC X(25)  VALUE SPACES.
  75.            03 FILLER              PIC X(11)  VALUE 'COSTO PLICO'.
  76.  
  77.        01  W-REC-DATI-FILE-REP-ST.
  78.            03 FILLER              PIC X.
  79.            03 W-REC-NUM-PLI       PIC X(12).
  80.            03 FILLER              PIC X(25)  VALUE SPACES.
  81.            03 W-COSTO-PLI         PIC Z(06)9,99.
  82.  
  83.        01  W-REC-TOTALE-ST.
  84.            03 FILLER              PIC X.
  85.            03 FILLER              PIC X(29).
  86.            03 FILLER              PIC X(8)   VALUE 'TOTALE: '.
  87.            03 W-REC-COSTO-TOT-ST  PIC Z(06)9,99.
  88.  
  89.       *ALTRE VARIABILI
  90.        01  EOF-FILE-PAN           PIC 9      VALUE ZERO.
  91.        01  EOF-FILE-PAL           PIC 9      VALUE ZERO.
  92.        01  EOF-FILE-DES           PIC 9      VALUE ZERO.
  93.        01  CONT-RIGHE-ST          PIC 9(06)  VALUE ZERO.
  94.  
  95.        01 SKEDA PARAMETRO
  96.           03 SK-DATA              PIC X(10)  VALUE ZERO.
  97.  
  98.        01  W-DIP-PAN-COM          PIC 9(05)  VALUE ZERO.
  99.        01  W-DIP-PAL-COM          PIC 9(05)  VALUE ZERO.
  100.  
  101.        01  SW-DIP-PRESENTE        PIC 9      VALUE ZERO.
  102.        01  SW-DESCRIZIONI         PIC 9      VALUE ZERO.
  103.       *
  104.        PROCEDURE DIVISION.
  105.       *
  106.        MAIN.
  107.            PERFORM INIZIO-PGM
  108.            PERFORM LEGGI-FILE-PAN
  109.            PERFORM LEGGI-FILE-PAL
  110.            PERFORM LEGGI-FILE-DES
  111.            PERFORM BILANCIA-DIP-PLI UNTIL EOF-FILE-PAN = 1 OR EOF-FILE-PAL = 1
  112.            PERFORM SCRIVI-TOTALE
  113.            PERFORM FINE-PGM.
  114.            .
  115.       *----------------*
  116.        INIZIO-PGM.
  117.       *----------------*
  118.            DISPLAY 'INIZIO PGM: 'NOME-PGM.
  119.            OPEN INPUT FILEPAN
  120.                 INPUT FILEPAL
  121.                 INPUT FILEDES
  122.                 OUTPUT FILEREP.
  123.            ACCEPT SKEDA-PARAMETRO.
  124.            MOVE SK-DATA TO W-REC-DATA-ST
  125.            .
  126.       *----------------*
  127.        BILANCIA-DIP-PLI.
  128.       *----------------*
  129.            PERFORM CONTROLLA-RIGHE
  130.            EVALUATE TRUE
  131.               WHEN W-COD-DIP-PAN = W-COD-DIP-PAL
  132.                    PERFORM CONTROLLA-PLICO
  133.               WHEN W-COD-DIP-PAN > W-COD-DIP-PAL
  134.                  PERFORM LEGGI-FILE-PAL
  135.               WHEN W-COD-DIP-PAN < W-COD-DIP-PAL
  136.                  PERFORM LEGGI-FILE-PAN
  137.            END-EVALUATE
  138.            .
  139.       *----------------*
  140.        CONTROLLA-PLICO.
  141.       *----------------*
  142.            EVALUATE TRUE
  143.               WHEN W-NUM-PLI-PAN = W-NUM-PLI-PAL
  144.                  PERFORM BILANCIA-FILE-DESCRIZIONI
  145.                     UNTIL SW-DESCRIZIONI = 1 OR EOF-FILE-DES = 1
  146.                  PERFORM CONTROLLA-NUOVA-DIP
  147.                  MOVE W-COD-DIP-PAN TO W-DIP-PAN-COM
  148.                  MOVE W-COD-DIP-PAL TO W-DIP-PAL-COM
  149.                  PERFORM SCRIVI-DATI
  150.                  PERFORM CALCOLA-TOTALE
  151.                  ADD 1 TO CONT-RIGHE-ST
  152.                  MOVE 1 TO SW-DIP-PRESENTE
  153.                  PERFORM LEGGI-FILE-PAL
  154.                  PERFORM LEGGI-FILE-PAN
  155.               WHEN W-NUM-PLI-PAN > W-NUM-PLI-PAL
  156.                  PERFORM LEGGI-FILE-PAL
  157.               WHEN W-NUM-PLI-PAN < W-NUM-PLI-PAL
  158.                  PERFORM LEGGI-FILE-PAN
  159.            END-EVALUATE
  160.            .
  161.       *----------------*
  162.        CONTROLLA-NUOVA-DIP.
  163.       *----------------*
  164.            IF SW-DIP-PRESENTE = 1
  165.               IF W-DIP-PAN-COM NOT = W-COD-DIP-PAN OR W-DIP-PAL-COM NOT = W-COD-DIP-PAL
  166.                  PERFORM SCRIVI-TOTALE
  167.                  PERFORM NUOVA-PAGINA
  168.                  PERFORM INTESTA-NUOVA-DIP
  169.                  MOVE 0 TO SW-DIP-PRESENTE
  170.                  MOVE 0 TO SW-DESCRIZIONE
  171.                  MOVE 0 TO CONT-RIGHE-REP
  172.               END-IF
  173.            END-IF
  174.            .
  175.       *----------------*
  176.        NUOVA-PAGINA.
  177.       *----------------*
  178.            INITIALIZE CONT-RIGHE-ST
  179.            ADD 1 TO W-PAG-ST
  180.            IF W-PAG-ST = 1
  181.               WRITE REC-FILE-STA FROM W-REC-DATA-PAG-ST
  182.            ELSE
  183.               WRITE REC-FILE-STA FROM W-REC-DATA-PAG-ST AFTER PAGE
  184.            END-IF
  185.            .
  186.       *----------------*
  187.        INTESTA-NUOVA-DIP.
  188.       *----------------*
  189.            WRITE REC-FILE-STA FROM W-REC-DIPENDENZA-ST AFTER 2 LINES
  190.            WRITE REC-FILE-STA FROM W-REC-DESCR-ST
  191.            PERFORM INTESTA-COLONNE
  192.            .
  193.       *----------------*
  194.        INTESTA-COLONNE.
  195.       *----------------*
  196.            WRITE REC-FILE-REP FROM W-REC-INT-COLONNE-ST AFTER 2 LINES
  197.            .
  198.       *----------------*
  199.        VALORIZZA-DATI-FILE-STA.
  200.       *----------------*
  201.            MOVE W-COSTO-PAN TO W-COSTO-PLI
  202.            MOVE W-NUM-PLI-PAN TO W-REC-NUM-PLI
  203.            .
  204.       *----------------*
  205.        CALCOLA-TOTALE.
  206.       *----------------*
  207.            ADD W-COSTO-PAN TO W-REC-COSTO-TOT-ST
  208.            .
  209.       *----------------*
  210.        SCRIVI-DATI.
  211.       *----------------*
  212.            PERFORM VALORIZZA-DATI-FILE-STA
  213.            WRITE REC-FILE-STA FROM W-REC-FILE-DATI-REP-ST
  214.            .
  215.       *----------------*
  216.        SCRIVI-TOTALE.
  217.       *----------------*
  218.            WRITE REC-FILE-STA FROM W-REC-TOTALE-ST
  219.            INITIALIZE W-REC-COSTO-TOT-ST
  220.            .
  221.       *----------------*
  222.        BILANCIA-FILE-DESCRIZIONI.
  223.       *----------------*
  224.            EVALUATE TRUE
  225.               WHEN W-COD-DIP-PAN = W-COD-DIP-DES
  226.                    PERFORM VALORIZZA-INTESTAZIONI
  227.               WHEN W-COD-DIP-PAN < W-COD-DIP-DES
  228.                    MOVE W-COD-DIP-PAN TO W-REC-DIPENDENZA
  229.                    PERFORM DESCR-MANCANTE
  230.                    MOVE 1 TO SW-DESCRIZIONI
  231.            END-EVALUATE
  232.            PERFORM LEFFI-FILE-DES
  233.            .
  234.       *----------------*
  235.        CONTROLLA-RIGHE.
  236.       *----------------*
  237.            IF CONT-RIGHE-REP > 55
  238.               PERFORM NUOVA-PAGINA
  239.               PERFORM INTESTA-COLONNE
  240.               MOVE 0 TO CONT-RIGHE-ST
  241.            END-IF
  242.            .
  243.       *----------------*
  244.        VALORIZZA-INTESTAZIONE.
  245.       *----------------*
  246.            MOVE W-COD-DIP-PAN TO W-REC-DIPENDENZA
  247.            MOVE W-DESCR-DES   TO W-REC-DESCR
  248.            .
  249.       *----------------*
  250.        LEGGI-FILE-PAN.
  251.       *----------------*
  252.            READ FILEPAN INTO W-REC-FILE-PAN
  253.               AT END MOVE 1 TO EOF-FILE-PAN
  254.            .
  255.       *----------------*
  256.        LEGGI-FILE-PAL.
  257.       *----------------*
  258.            READ FILEPAL INTO W-REC-FILE-PAL
  259.               AT END MOVE 1 TO EOF-FILE-PAL
  260.            .
  261.       *----------------*
  262.        LEGGI-FILE-DES.
  263.       *----------------*
  264.            READ FILEDES INTO W-REC-FILE-DES
  265.               AT END MOVE 1 TO EOF-FILE-DES
  266.            .
  267.       *----------------*
  268.        SCRIVI-FILE-STA.
  269.       *----------------*
  270.            PERFORM VALORIZZA-REC-FILE-REP
  271.            WRITE REC-FILE-STA FROM W-REC-FILE-STA.
  272.            .
  273.       *----------------*
  274.        DESCR-MANCANTE.
  275.       *----------------*
  276.            MOVE 'DESCRIZIONE MANCANTE' TO W-REC-DESCR
  277.            .
  278.       *----------------*
  279.        FINE-PGM.
  280.       *----------------*
  281.            CLOSE FILEPAN
  282.                  FILEPAL
  283.                  FILEDES
  284.                  FILESTA.
  285.            DISPLAY 'FINE PGM: 'NOME-PGM.
  286.            GOBACK.
  287.            .
  288. 
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!