API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 9th, 2017
92
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 15.62 KB | None | 0 0
raw download clone embed print report
  1.   IDENTIFICATION DIVISION.
  2.        PROGRAM-ID STAX011B.
  3.        AUTHOR. BORDIN ALEX.
  4.       *-----------------------------------------------
  5.        ENVIRONMENT DIVISION.
  6.        INPUT-OUTPUT SECTION.
  7.        FILE-CONTROL.
  8.            SELECT FILECLI ASSIGN                 TO FILECLI.
  9.            SELECT FILESTA ASSIGN                 TO FILESTA.
  10.       *
  11.        DATA DIVISION.
  12.       *
  13.        FILE SECTION.
  14.       *
  15.        FD  FILECLI
  16.            LABEL RECORD IS STANDARD.
  17.        01  REC-FILE-CLI                          PIC X(100).
  18.       *
  19.        FD  FILESTA
  20.            LABEL RECORD IS STANDARD.
  21.        01  REC-FILE-STA                          PIC X(132).
  22.       *
  23.        WORKING-STORAGE SECTION.
  24.       *
  25.        01  NOME-PGM                              PIC X(08) VALUE 'STAX011B'.
  26.  
  27.       *TRACCIATO FILE-CLI
  28.        01  W-REC-FILE-CLI.
  29.            03 W-COD-CLIENTE-CLI                  PIC 9(16).
  30.            03 W-DENOMINAZIONE-CLI                PIC X(60).
  31.  
  32.       *TRACCIATO FILE-STA
  33.        01  W-REC-INTESTA-CLI.
  34.            03 FILLER                             PIC X.
  35.            03 FILLER                             PIC X(16) VALUE '*CODICE CLIENTE*'.
  36.            03 FILLER                             PIC X.
  37.            03 FILLER                             PIC X(60)  VALUE '*---------------------'
  38.       -                                          'DENOMINAZIONE------------------------*'.
  39.            03 FILLER                             PIC X.
  40.            03 FILLER                             PIC X(13) VALUE 'NUMERO PAGINA'.
  41.  
  42.        01  W-REC-DATI-CLI.
  43.            03 FILLER                             PIC X.
  44.            03 W-COD-CLIENTE-STA                  PIC 9(16).
  45.            03 FILLER                             PIC X.
  46.            03 W-DENOMINAZIONE-STA                PIC X(60).
  47.            03 FILLER                             PIC X(07).
  48.            03 W-NUM-PAG-STA                      PIC Z9(06).
  49.  
  50.        01  W-REC-INTESTA-IND.
  51.            03 FILLER                             PIC X.
  52.            03 FILLER                             PIC X(60)  VALUE '*---------------------'
  53.       -                                          '-----VIA-----------------------------*'.
  54.            03 FILLER                             PIC X.
  55.            03 FILLER                             PIC X(30) VALUE '*------------COMUNE-----'
  56.       -                                          '-----*'.
  57.            03 FILLER                             PIC X.
  58.            03 FILLER                             PIC X(19)  VALUE '*----TELEFONO-----*'.
  59.  
  60.        01  W-REC-DATI-IND.
  61.            03 FILLER                             PIC X.
  62.            03 W-VIA-STA                          PIC X(60).
  63.            03 FILLER                             PIC X.
  64.            03 W-COMUNE-STA                       PIC X(30).
  65.            03 FILLER                             PIC X.
  66.            03 W-TELEFONO-STA                     PIC Z9(18).
  67.  
  68.        01  W-REC-COLONNE-PRO.
  69.            03 FILLER                             PIC X.
  70.            03 FILLER                             PIC X(10)  VALUE 'DATA ORDINE'.
  71.            03 FILLER                             PIC X.
  72.            03 FILLER                             PIC X(15) VALUE '*CODICE ORDINE*'.
  73.            03 FILLER                             PIC X.
  74.            03 FILLER                             PIC X(30) VALUE '*---DESCRIZIONE PRODOTTO'
  75.       -                                          '-----*'.
  76.            03 FILLER                             PIC X.
  77.            03 FILLER                             PIC X(10) VALUE '*QUANTITA*'.
  78.            03 FILLER                             PIC X.
  79.            03 FILLER                             PIC X(18) VALUE '*IMPORTO UNITARIO*'.
  80.  
  81.        01  W-REC-DATI-PRO.
  82.            03 FILLER                             PIC X.
  83.            03 W-DATA-ORDINE-STA                  PIC X(10).
  84.            03 FILLER                             PIC X.
  85.            03 W-CODICE-ORDINE-STA                PIC 9(15).
  86.            03 FILLER                             PIC X.
  87.            03 W-DESCR-PROD-STA                   PIC X(30).
  88.            03 FILLER                             PIC X.
  89.            03 W-QUANT-STA                        PIC 9(10).
  90.            03 FILLER                             PIC X.
  91.            03 W-IMPORTO-UNI-STA                  PIC 9(18).
  92.  
  93.        01  W-REC-TOTALE-STA.
  94.            03 FILLER                             PIC X.
  95.            03 FILLER                             PIC X(53).
  96.            03 FILLER                             PIC X(15) VALUE 'TOTALE FATTURA:'.
  97.            03 FILLER                             PIC X.
  98.            03 W-TOTALE-STA                       PIC 9(18).
  99.  
  100.       *DATI SCHEDA PARAMETRO
  101.        01  SKEDA PARAMETRO.
  102.            03 SK-DATA-CTRL                       PIC X(10).
  103.  
  104.       *COMODI
  105.        01  COMODI.
  106.            03 Z-SQL                              PIC -(04)  VALUE ZERO.
  107.  
  108.       *PER AMBEND
  109.        01  DAMP                                  PIC X VALUE SPACE.
  110.        01  DUMP REDEFINES DAMP                   PIC S9.
  111.  
  112.       *ALTRE VARIABILI
  113.        01  W-DATA-CTRL.
  114.        01  FILLER REDEFINES W-DATA-CTRL.
  115.            03 W-GIORNO-CTRL                      PIC X(02).
  116.            03 FILLER                             PIC X(01).
  117.            03 W-MESE-CTRL                        PIC X(02).
  118.            03 FILLER                             PIC X(01).
  119.            03 W-ANNO-CTRL                        PIC X(04).
  120.  
  121.        01  W-DATA-LIMITE-SUP                     PIC X(10).
  122.        01  FILLER REDEFINES W-DATA-LIMITE-SUP.
  123.            03 W-ANNO-SUP                         PIC X(04).
  124.            03 TRAT1                              PIC X(01).
  125.            03 W-MESE-SUP                         PIC X(02).
  126.            03 TRAT2                              PIC X(01).
  127.            03 W-GIORNO-SUP                       PIC X(02).
  128.  
  129.        01  W-DATA-LIMITE-INF                     PIC X(10).
  130.        01  FILLER REDEFINES W-DATA-LIMITE-INF.
  131.            03 FILLER                             PIC X(08).
  132.            03 W-GIORNO-INF                       PIC X(02).
  133.  
  134.       *CONTATORI
  135.        01  CONT-RIGHE-PAG                        PIC 9(06) VALUE ZERO.
  136.        01  MAX-RIGHE-PAG                         PIC 9(06) VALUE 30.
  137.        01  W-NUM-PAG                             PIC 9(06) VALUE ZERO.
  138.        01  CONT-RIGHE-CLI                        PIC 9(06) VALUE ZERO.
  139.        01  CONT-CLI                              PIC 9(06) VALUE ZERO.
  140.        01  CONT-CLI-0                            PIC 9(06) VALUE ZERO.
  141.        01  CONT-WRITE                            PIC 9(06) VALUE ZERO.
  142.        01  CONT-NO-WRITE                         PIC 9(06) VALUE ZERO.
  143.  
  144.       *COUNT
  145.        01 COUNT-ORDINI                           PIC S9(09) COMP-3 VALUE ZERO.
  146.  
  147.       *SWITCH
  148.        01 SW-PRIMA-PAG                           PIC 9     VALUE ZERO.
  149.  
  150.  
  151.       *INCLUDE TABELLE DB2
  152.            EXEC SQL INCLUDE SQLCA     END-EXEC.
  153.            EXEC SQL INCLUDE VC00TA91  END-EXEC.
  154.  
  155.       *CURSORI
  156.            EXEC SQL DECLARE CURS-ORDINI CURSOR FOR
  157.             SELECT AREA-DATI
  158.             FROM VC0ORDINI
  159.             WHERE TA91_COD_CLIENTE = :TA91-COD-CLIENTE
  160.              AND TA91_DATA_ORDINE BETWEEN :W-DATA-LIMITE-INF AND :W-DATA-LIMITE-SUP
  161.             FOR FETCH ONLY
  162.            END-EXEC.
  163.  
  164.       *EOF
  165.        01 EOF-FILE-CLI                           PIC 9 VALUE 0.
  166.  
  167.       *ROUTINE
  168.        01  STAX011R                              PIC X(08) VALUE 'STAX011R'.
  169.        COPY STAX011C.
  170.  
  171.       *
  172.        PROCEDURE DIVISION.
  173.       *
  174.        MAIN.
  175.            PERFORM INIZIO-PGM
  176.  
  177.            PERFORM PREPARA-DATE
  178.  
  179.            PERFORM LEGGI-FILE-CLI
  180.  
  181.            PERFORM ELABORA-CLI-ORD UNTIL EOF-FILE-CLI = 1
  182.  
  183.            PERFORM DISPLAY-REPORT
  184.            PERFORM FINE-PGM.
  185.            .
  186.       *----------------*
  187.        INIZIO-PGM.
  188.       *----------------*
  189.            DISPLAY 'INIZIO PGM: 'NOME-PGM
  190.            OPEN INPUT FILECLI
  191.                OUTPUT FILESTA
  192.            ACCEPT SKEDA-PARAMETRO
  193.            .
  194.       *----------------*
  195.        ELABORA-CLI-ORD.
  196.       *----------------*
  197.            PERFORM COUNT-ORDINI-CLI
  198.            ADD 1                                 TO CONT-RIGHE-CLI
  199.  
  200.            IF COUNT-ORDINI > 0
  201.               PERFORM CHIAMA-STAX011R
  202.               ADD 1                              TO CONT-CLI
  203.  
  204.               IF RETURNCODE-RC-STAX011R = 0
  205.                  INITIALIZE W-NUM-PAG
  206.                  PERFORM INTESTA-PAGINA
  207.  
  208.                  PERFORM OPEN-CURS-ORD
  209.                  PERFORM FETCH-CURS-ORD
  210.  
  211.                  PERFORM SCRIVI-DATI-STA UNTIL SQLCODE = 100
  212.  
  213.                  PERFORM CLOSE-CURS-ORD
  214.  
  215.                  PERFORM SCRIVI-TOTALE
  216.                  ADD 1                           TO CONT-WRITE
  217.               ELSE
  218.                  ADD 1                           TO CONT-NO-WRITE
  219.               END-IF
  220.            ELSE
  221.               ADD 1                              TO CONT-CLI-0
  222.            END-IF
  223.            PERFORM LEGGI-FILE-CLI
  224.            .
  225.       *----------------*
  226.        INTESTA-PAGINA.
  227.       *----------------*
  228.            ADD 1                                 TO W-NUM-PAG
  229.            PERFORM VALORIZZA-DATI-CLI
  230.  
  231.            IF SW-PRIMA-PAG = 0
  232.               WRITE REC-FILE-STA                 FROM W-REC-INTESTA-CLI
  233.            ELSE
  234.               WRITE REC-FILE-STA                 FROM W-REC-INTESTA-CLI AFTER PAGE
  235.            END-IF
  236.  
  237.            WRITE REC-FILE-STA                    FROM W-REC-DATI-CLI
  238.            WRITE REC-FILE-STA                    FROM W-REC-INTESTA-IND
  239.            WRITE REC-FILE-STA                    FROM W-REC-DATI-IND
  240.            WRITE REC-FILE-STA                    FROM W-REC-COLONNE-PRO AFTER LINES
  241.  
  242.            MOVE 1                                TO SW-PRIMA-PAG
  243.            .
  244.       *----------------*
  245.        VALORIZZA-DATI-CLI.
  246.       *----------------*
  247.            MOVE COD-CLIENTE-OUTPUT-STAX011R      TO W-COD-CLIENTE-STA
  248.            MOVE DENOMINAZIONE-OUTPUT-STAX011R    TO W-DENOMINAZIONE-STA
  249.            MOVE W-NUM-PAG                        TO W-NUM-PAG-STA
  250.  
  251.            MOVE VIA-OUTPUT-STAX011R              TO W-VIA-STA
  252.            MOVE COMUNE-OUTPUT-STAX011R           TO W-COMUNE-STA
  253.            MOVE TELEFONO-OUTPUT-STAX011R         TO W-TELEFONO-STA
  254.            .
  255.       *----------------*
  256.        SCRIVI-TOTALE.
  257.       *----------------*
  258.            WRITE REC-FILE-STA                    FROM W-REC-TOTALE-STA
  259.            INITIALIZE W-TOTALE-STA
  260.            .
  261.       *----------------*
  262.        COUNT-ORDINI-CLI.
  263.       *----------------*
  264.            MOVE W-COD-CLIENTE-CLI                TO TA91-COD-CLIENTI
  265.  
  266.            EXEC SQL
  267.               SELECT COUNT(*)
  268.                  INTO :COUNT-ORDINI
  269.               FROM VC0ORDINI
  270.               WHERE TA91_COD_CLIENTI = :TA91-COD-CLIENTI
  271.              AND TA91_DATA_ORDINE BETWEEN :W-DATA-LIMITE-INF AND :W-DATA-LIMITE-SUP
  272.            END-EXEC
  273.  
  274.            IF SQLCODE NOT = 0
  275.               MOVE SQLCODE                       TO Z-SQL
  276.               DISPLAY 'ERRORE IN COUNT VC0ORDINI'
  277.               DISPLAY 'SQLCODE: ' Z-SQL
  278.               DISPLAY 'TA91_COD_CLIENTI: ' TA91-COD-CLIENTI
  279.               ADD 1                              TO DUMP
  280.            END-IF
  281.            .
  282.       *----------------*
  283.        SCRIVI-DATI-STA.
  284.       *----------------*
  285.            IF TA9100-TIPO-RECORD = 1
  286.               MOVE TA9101-COD-ORDINE             TO W-COD-ORDINE
  287.               ADD TA9101-IMPORTO-TOT             TO W-TOTALE-STA
  288.            ELSE
  289.               PERFORM SCRIVI-DATI-PRO
  290.            END-IF
  291.            PERFORM FETCH-CURS-ORD
  292.            .
  293.       *----------------*
  294.        SCRIVI-DATI-PRO.
  295.       *----------------*
  296.            PERFORM CONTROLLA-FINE-RIGHE
  297.  
  298.            MOVE TA9100-DATA-ORDINE               TO W-DATA-ORDINE-STA
  299.            MOVE W-COD-ORDINE                     TO W-CODICE-ORDINE-STA
  300.            MOVE TA9102-DESCR-PROD                TO W-DESCR-PROD-STA
  301.            MOVE TA9102-QUANT                     TO W-QUANT-STA
  302.            MOVE TA9102-IMPORTO                   TO W-IMPORTO-UNI-STA
  303.  
  304.            WRITE REC-FILE-STA FROM W-REC-DATI-PRO
  305.            ADD 1                                 TO CONT-RIGHE-PAG
  306.            .
  307.       *----------------*
  308.        CONTROLLA-FINE-RIGHE.
  309.       *----------------*
  310.            IF CONT-RIGHE-PAG > MAX-RIGHE-PAG
  311.               PERFORM INTESTA-PAGINA
  312.               INITIALIZE CONT-RIGHE-PAG
  313.            END-IF
  314.            .
  315.       *----------------*
  316.        PREPARA-DATE.
  317.       *----------------*
  318.            MOVE SK-DATA-CTRL                     TO W-DATA-CTRL
  319.  
  320.            MOVE '-'                              TO TRAT1
  321.            MOVE '-'                              TO TRAT2
  322.            MOVE 31                               TO W-GIORNO-SUP
  323.            MOVE W-MESE-CTRL                      TO W-MESE-SUP
  324.            MOVE W-ANNO-CTRL                      TO W-ANNO-SUP
  325.  
  326.            MOVE W-DATA-SUP                       TO W-DATA-INF
  327.  
  328.            MOVE 1                                TO W-GIORNO-INF
  329.            .
  330.       *----------------*
  331.        CHIAMA-STAX011R.
  332.       *----------------*
  333.            INITIALIZE AREA-STAX011R
  334.  
  335.            MOVE 'RIC'                            TO AZIONE-INPUT-STAX011R
  336.            MO0E W-COD-CLIENTE-CLI                TO COD-CLIENTE-INPUT-STAX011R
  337.  
  338.            CALL STAX011R USING AREA-STAX011R
  339.  
  340.            EVALUATE RETURNCODE-RC-STAX011R
  341.             WHEN 4
  342.                DISPLAY MESSAGE-RC-STAX011R
  343.                ADD 1                             TO CONT-NO-WRITE
  344.             WHEN 8
  345.             WHEN 12
  346.                DISPLAY MESSAGE-RC-STAX011R
  347.                ADD 1                             TO DUMP
  348.            END-EVALUATE
  349.            .
  350.       *----------------*
  351.        OPEN-CURS-ORD.
  352.       *----------------*
  353.            INITIALIZE VC00TAB91
  354.  
  355.            MOVE W-COD-CLIENTE-CLI                TO TA91-COD-CLIENTE
  356.  
  357.            EXEC SQL
  358.             OPEN CURS-ORD
  359.            END-EXEC
  360.  
  361.            IF SQLCODE NOT = 0
  362.               MOVE SQLCODE                       TO Z-SQL
  363.               DISPLAY 'ERRORE IN OPEN CURSORE'
  364.               DISPLAY 'SQLCODE: ' Z-SQL
  365.               DISPLAY 'CURSORE: CURS-ORD'
  366.               ADD 1                              TO DUMP
  367.            END-IF
  368.            .
  369.       *----------------*
  370.        FETCH-CURS-ORD.
  371.       *----------------*
  372.            EXEC SQL
  373.             FETCH CURS-ORD
  374.             INTO :AREA-DATI
  375.            END-EXEC
  376.  
  377.            IF SQLCODE NOT = 100 AND NOT = 0
  378.               MOVE SQLCODE                       TO Z-SQL
  379.               DISPLAY 'ERRORE IN FETCH CURSORE'
  380.               DISPLAY 'CURSORE: CURS-ORD'
  381.               DISPLAY 'SQLCODE: ' Z-SQL
  382.               ADD 1                              TO DUMP
  383.            END-IF
  384.            .
  385.       *----------------*
  386.        CLOSE-CURS-ORD.
  387.       *----------------*
  388.            EXEC SQL
  389.             CLOSE CURS-ORD
  390.            END-EXEC
  391.  
  392.            IF SQLCODE NOT = 0
  393.               MOVE SQLCODE                       TO Z-SQL
  394.               DISPLAY 'ERRORE IN CLOSE CURSORE'
  395.               DISPLAY 'SQLCODE: ' Z-SQL
  396.               DISPLAY 'CURSORE: CURS-ORD'
  397.               ADD 1                              TO DUMP
  398.            END-IF
  399.            .
  400.       *----------------*
  401.        DISPLAY-REPORT.
  402.       *----------------*
  403.            DISPLAY '*----------------------REPORT-----------------------*'
  404.            DISPLAY 'RIGHE LETE NEL FILE-CLI            : ' CONT-RIGHE-CLI
  405.            DISPLAY 'CLIENTI CON ALMENO 1 ORDINE        : ' CONT-CLI
  406.            DISPLAY 'CLIENTI CON ALMENO 0 ORDINI        : ' CONT-CLI-0
  407.            DISPLAY 'CLIENTI NON SCRITTI IN FILE STAMPA : ' CONT-NO-WRITE
  408.            DISPLAY 'CLIENTI SCRITTI IN FILE STAMPA     : ' CONT-WRITE
  409.            DISPLAY '*----------------------------------------------------*'
  410.            .
  411.       *----------------*
  412.        LEGGI-FILE-CLI.
  413.       *----------------*
  414.            READ FILECLI INTO W-REC-FILE-CLI
  415.               AT END MOVE 1                      TO EOF-FILE-CLI
  416.            .
  417.       *----------------*
  418.        FINE-PGM.
  419.       *----------------*
  420.            CLOSE FILECLI
  421.                  FILESTA
  422.            DISPLAY 'FINE PGM: 'NOME-PGM
  423.            GOBACK
  424.            .
  425. 
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!