API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 10th, 2017
92
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 13.29 KB | None | 0 0
raw download clone embed print report
  1.      *---------------------------------------------------------------*
  2.       *STAVE01B DATO UN FILE DI INPUT CON TRACCIATO
  3.       * 01 REC-RICHIESTE.
  4.       *  03 FISCALE-RICH                        PIC X(16).
  5.       *  03 COD-CONS-RICH                       PIC 9(60).
  6.       * ACCEDERE ALLA VC0VISUREBENI E PER OGNI BENE TROVATO
  7.       * ACCEDERE ALLA VC0IMMOBILI CON FISCALE, CONSERVATORIA E
  8.       * COD-BENE-BENI E SCRIVERE UN FILE DI OUTPUT COME DA STAIMM01C;
  9.       * UTILIZZARE UNA ROUTINE PER OTTENERE DES-CONS-IMM ACCEDENDO A
  10.       * VC0CONSERVATORIE; DATA OPERAZIONE E MATRICOLA SI OTTENGONO DA
  11.       * SKEDA-PARAMETRO.
  12.       * --------------------------------------------------------------*
  13.  
  14.        IDENTIFICATION DIVISION.
  15.        PROGRAM-ID. STAVE01B.
  16.        AUTHOR. MAZZAROLO MATTEO.
  17.        DATE-WRITTEN. 2011-01-10.
  18.  
  19.        ENVIRONMENT DIVISION.
  20.  
  21.        INPUT-OUTPUT SECTION.
  22.  
  23.        FILE-CONTROL.
  24.        SELECT FILERICH   ASSIGN TO FILERICH.
  25.        SELECT FILEIMM    ASSIGN TO FILEIMM.
  26.  
  27.        DATA DIVISION.
  28.  
  29.        FILE SECTION.
  30.  
  31.        FD FILERICH   LABEL RECORD IS STANDARD.
  32.        01 REC-FILERICH                           PIC X(200).
  33.        FD FILEIMM    LABEL RECORD IS STANDARD.
  34.        01 REC-FILEIMM                            PIC X(200).
  35.  
  36.        WORKING-STORAGE SECTION.
  37.  
  38.       * INFO PROGRAMMA
  39.        01 NOME-PGM                               PIC X(08) VALUE 'STAVE01B'.
  40.  
  41.       * DATI SKEDA-PARAMETRO
  42.        01 SKEDA-PARAMETRO.
  43.          03 SK-DATA-OPE                          PIC X(08).
  44.          03 FILLER                               PIC X(01).
  45.          03 SK-MATR-OPE                          PIC X(08).
  46.  
  47.       * RECORD FILERICH
  48.        01 W-REC-RICHIESTE.
  49.          03 FISCALE-RICH                         PIC X(16).
  50.          03 COD-CONS-RICH                        PIC 9(05).
  51.  
  52.  
  53.       * DATA-COMODO
  54.        01 DATA-COMODO                            PIC X(08).
  55.        01 FILLER REDEFINES DATA-COMODO.
  56.          03 DATA-COMODO-GIORNO                   PIC X(02).
  57.          03 DATA-COMODO-MESE                     PIC X(02).
  58.          03 DATA-COMODO-ANNO                     PIC X(04).
  59.  
  60.       * DATA-DB2
  61.        01 DATA-DB2                               PIC X(10).
  62.        01 FILLER REDEFINES DATA-DB2.
  63.          03 DATA-DB2-GIORNO                      PIC X(04).
  64.          03 DATA-DB2-TRAT1                       PIC X(01).
  65.          03 DATA-DB2-MESE                        PIC X(02).
  66.          03 DATA-DB2-TRAT2                       PIC X(01).
  67.          03 DATA-DB2-GIORNO                      PIC X(02).
  68.  
  69.       * EOF
  70.        01 EOF-FILERICH                           PIC 9(01).
  71.  
  72.       * ALTRE VARIABILI
  73.        01 SQLCODE-VC0IMMOBILI                    PIC 9(06).
  74.        01 SQLCODE-VC0VISUREANAG                  PIC 9(06).
  75.        01 SW-NESSUN-ERRORE                       PIC 9(06) VALUE ZERO.
  76.        01 CONT-RIGHE-FILERICH                    PIC 9(06) VALUE ZERO.
  77.        01 CONT-RIGHE-FILEIMM                     PIC 9(06) VALUE ZERO.
  78.        01 CONT-BENI-TOT                          PIC 9(06) VALUE ZERO.
  79.  
  80.       * COMODI
  81.        01 COMODI.
  82.          02 Z-SQL                                PIC -(4) VALUE ZERO.
  83.  
  84.       * PER ABEND
  85.        01 DAMP                                   PIC X VALUE SPACE.
  86.        01 DUMP REDIFINES DAMP                    PIC S9.
  87.  
  88.       * INCLUDE TABELLE DB2
  89.            EXEC SQL INCLUDE SQLCA                END-EXEC.
  90.            EXEC SQL INCLUDE VC00TA16             END-EXEC.
  91.            EXEC SQL INCLUDE VC00TA17             END-EXEC.
  92.            EXEC SQL INCLUDE VC00TA60             END-EXEC.
  93.  
  94.       * CURS-VC0VISUREBENI
  95.            EXEC SQL DECLARE CURS-VC0VISUREBENI CURSOR FOR
  96.              SELECT *
  97.                FROM VC00TA17
  98.                WHERE FISCALE_BENI      = :FISCALE-BENI
  99.                AND   COD_CONSERV_BENI  = :COD-CONSERV-BENI
  100.                AND   TIPO_REC_BENI     = :TIPO-REC-BENI
  101.              FOR FETCH ONLY
  102.            END-EXEC.
  103.  
  104.       * TRACCIATO FILEIMM
  105.        COPY STAIMM1C.
  106.  
  107.       * ROUTINES
  108.        01 STAVE01R                               PIC X(08) VALUE 'STAVE01R'.
  109.        COPY STAVE01C.
  110.  
  111.        PROCEDURE DIVISION.
  112.  
  113.       *------
  114.        MAIN.
  115.       *------
  116.          PERFORM INIZIALIZZA
  117.  
  118.          PERFORM LEGGI-FILERICH
  119.          PERFORM CONTROLLA-FILERICH UNTIL EOF-FILERICH = 1
  120.  
  121.          PERFORM REPORT-FINE-PGM
  122.          PERFORM FINE-PGM
  123.          .
  124.  
  125.       *-------------
  126.        INIZIALIZZA.
  127.       *-------------
  128.          DISPLAY 'INIZIO PGM ' NOME-PGM
  129.  
  130.          OPEN INPUT  FILERICH
  131.               OUTPUT FILEIMM
  132.  
  133.          ACCEPT SKEDA-PARAMETRO
  134.          MOVE SK-DATA-OPE                        TO DATA-COMODO
  135.  
  136.          MOVE DATA-COMODO-ANNO                   TO DATA-DB2-ANNO
  137.          MOVE DATA-COMODO-MESE                   TO DATA-DB2-MESE
  138.          MOVE DATA-COMODO-GIORNO                 TO DATA-DB2-GIORNO
  139.          MOVE '-'                                TO DATA-DB2-TRAT1
  140.          MOVE '-'                                TO DATA-DB2-TRAT2
  141.          .
  142.  
  143.       *--------------------
  144.        CONTROLLA-FILERICH.
  145.       *--------------------
  146.          PERFORM OPEN-CURS-VC0VISUREBENI
  147.          PERFORM FETCH-CURS-VC0VISUREBENI
  148.          PERFORM OTTIENI-DATI
  149.            UNTIL SQLCODE = 100
  150.          PERFORM CLOSE-CURS-VC0VISUREBENI
  151.  
  152.          PERFORM LEGGI-FILERICH
  153.          .
  154.  
  155.       *--------------
  156.        OTTIENI-DATI.
  157.       *--------------
  158.          PERFORM SELECT-VC0IMMOBILI
  159.          MOVE SQLCODE                            TO SQLCODE-VC0IMMOBILI
  160.          PERFORM SELECT-VC0VISUREANAG
  161.          MOVE SQLCODE                            TO SQLCODE-VC0VISUREANAG
  162.          MOVE AREA-DATI-BENI                     TO VC00VIDF
  163.          PERFORM CHIAMA-STAVE01E
  164.          PERFORM CONTROLLA-ERRORI
  165.          IF SW-NESSUN-ERRORE = 1
  166.            PERFORM VALORIZZA-REC-IMMOB
  167.            PERFORM SCRIVI-FILEIMM
  168.            INITIALIZE SW-NESSUN-ERRORE
  169.          END-IF
  170.          ADD 1 TO CONT-BENI-TOT
  171.  
  172.          PERFORM FETCH-CURS-VC0VISUREBENI
  173.          .
  174.  
  175.       *-----------------
  176.        CHIAMA-STAVE01R.
  177.       *-----------------
  178.          INITIALIZE AREA-STAVE01R
  179.          MOVE 'CON'                              TO AZIONE-INPUT-STAVE01R
  180.          MOVE COD-CONS-RICH                      TO COD-CONS-INPUT-STAVE01R
  181.  
  182.          CALL STAVE01R USING STAVE01C
  183.          .
  184.  
  185.       *------------------
  186.        CONTROLLA-ERRORI.
  187.       *------------------
  188.          EVALUATE TRUE
  189.          WHEN RETURNCODE-RC-STAVE01R = 4
  190.             DISPLAY MESSAGE-RC-STAVE01R
  191.             DISPLAY 'ERRORE IN ' FISCALE-RICH' E ' COD-CONS-RICH
  192.          WHEN RETURNCODE-RC-STAVE01R = 8
  193.          WHEN RETURNCODE-RC-STAVE01R = 12
  194.             DISPLAY MESSAGE-RC-STAVE01R
  195.             ADD 1                                TO DUMP
  196.          WHEN SQLCODE-VC0IMMOBILI = 100
  197.             DISPLAY 'SELECT VUOTO IN VC0IMMOBILI PER 'FISCALE-RICH' E 'COD-CONS-RICH
  198.          WHEN SQLCODE-VC0VISUREANAG = 100
  199.             DISPLAY 'SELECT VUOTO IN VC0VISUREANAG PER 'FISCALE-RICH' E 'COD-CONS-RICH
  200.          WHEN OTHER
  201.            MOVE 1                                TO SW-NESSUN-ERRORE
  202.            ADD 1                                 TO CONT-BENI-NESSUN-ERRORE
  203.          END-EVALUATE
  204.          .
  205.  
  206.       *--------------------
  207.        SELECT-VC0IMMOBILI.
  208.       *--------------------
  209.          INITIALIZE VC00TAB60
  210.  
  211.          MOVE FISCALE-BENI                       TO COD-FISC-IMM
  212.          MOVE COD-CONSERV-BENI                   TO COD-CONS-IMM OF VC0IMMOBILI
  213.          MOVE COD-BENE-BENI                      TO FORN-COD-BENE-IMM
  214.  
  215.            EXEC SQL
  216.              SELECT *
  217.                INTO :VC00TA60
  218.                FROM VC0IMMOBILI
  219.                WHERE COD_FISC_IMM  = :COD-FISC-IMM
  220.                AND   COD_CONS_IMM  = :COD-CONS-IMM OF VC0IMMOBILI
  221.                AND   FORN_COD_BENE_IMM  = :FORN-COD-BENE-IMM
  222.            END-EXEC
  223.  
  224.          IF SQLCODE NOT = ZERO
  225.            MOVE SQLCODE                          TO Z-SQL
  226.            DISPLAY 'ERRORE IN SELECT IN VC0IMMOBILI'
  227.            DISPLAY 'SQLCODE: ' Z-SQL
  228.            DISPLAY 'COD_FISC_IMM:' COD-FISC-IMM
  229.            DISPLAY 'COD_CONS_IMM: ' COD-CONS-IMM OF VC0IMMOBILI
  230.            DISPLAY 'FORN_COD_BENE_IMM: ' FORN-COD-BENE-IMM
  231.            ADD 1                                 TO DUMP
  232.          END-IF
  233.          .
  234.  
  235.       *----------------------
  236.        SELECT-VC0VISUREANAG.
  237.       *----------------------
  238.          INITIALIZE VC00TAB16
  239.  
  240.          MOVE FISCALE-BENI                       TO FISCALE-ANAG
  241.          MOVE COD-CONSERV-BENI                   TO COD-CONSERV-ANAG
  242.  
  243.            EXEC SQL
  244.              SELECT *
  245.                INTO :VC00TA16
  246.                FROM VC0VISUREANAG
  247.                WHERE FISCALE_ANAG   = :FISCALE-ANAG
  248.                AND   COD_CONSERV_ANAG = :COD-CONSERV-ANAG
  249.            END-EXEC
  250.  
  251.          IF SQLCODE NOT = ZERO
  252.            MOVE SQLCODE                          TO Z-SQL
  253.            DISPLAY 'ERRORE IN SELECT IN VC0IMMOBILI'
  254.            DISPLAY 'SQLCODE: ' Z-SQL
  255.            DISPLAY 'FISCALE_ANAG: ' FISCALE-ANAG
  256.            DISPLAY 'COD_CONSERV_ANAG: ' COD-CONSERV-ANAG
  257.            ADD 1                                 TO DUMP
  258.          END-IF
  259.          .
  260.  
  261.       *---------------------
  262.        VALORIZZA-REC-IMMOB.
  263.       *---------------------
  264.          MOVE FISCALE-RICH                       TO FISCALE-IMM
  265.          MOVE NOME-ANAG   OF VC0VISUREANAG       TO NOME-ANAG   OF REC-IMMOB
  266.          MOVE COD-CONS-RICH                      TO COD-CONS-IMM
  267.          MOVE DES-CONS-OUTPUT-STAVE01R           TO DES-CONS-IMM
  268.          MOVE SEZIONE-IMM OF VC0IMMOBILI         TO SEZIONE-IMM OF REC-IMMOB
  269.          MOVE FOGLIO-IMM  OF VC0IMMOBILI         TO FOGLIO-IMM  OF REC-IMMOB
  270.          MOVE MAPPALE-IMM OF VC0IMMOBILI         TO MAPPALE-IMM OF REC-IMMOB
  271.          MOVE COMUNE-IMM  OF VC0IMMOBILI         TO COMUNE-IMM  OF REC-IMMOB
  272.          MOVE PROVINCIA-IMM                      TO PROV-IMM
  273.          MOVE DATA-DB2                           TO DATA-OPE
  274.          MOVE SK-MATR-OPE                        TO MATR-OPE
  275.          MOVE VD02-TIPO-DEL-BENE                 TO TIPO-BENE
  276.          MOVE VD02-VAL-RENDITA-CAT               TO VAL-RENDITA-CAT
  277.          .
  278.  
  279.       *-------------------------
  280.        OPEN-CURS-VC0VISUREBENI.
  281.       *-------------------------
  282.          INITIALIZE VC00TAB17
  283.  
  284.          MOVE FISCALE-RICH                       TO FISCALE-BENI
  285.          MOVE COD-CONS-RICH                      TO COD-CONSERV-BENI
  286.          MOVE 2                                  TO TIPO-REC-BENI
  287.  
  288.            EXEC SQL
  289.              OPEN CURS-VC0VISUREBENI
  290.            END-EXEC
  291.  
  292.          IF SQLCODE NOT = 0
  293.            MOVE SQLCODE                          TO Z-SQL
  294.            DISPLAY 'ERRORE IN APERTURA DI CURS-VC0VISUREBENI'
  295.            DISPLAY 'SQLCODE: ' Z-SQL
  296.            DISPLAY 'FISCALE_BENI: ' FISCALE-BENI
  297.            DISPLAY 'COD_CONSERV_RICH: ' COD-CONSERV-RICH
  298.            DISPLAY 'TIPO_REC_BENI: ' TIPO-REC-BENI
  299.            ADD 1                                 TO DUMP
  300.          END-IF
  301.          .
  302.  
  303.       *--------------------------
  304.        FETCH-CURS-VC0VISUREBENI.
  305.       *--------------------------
  306.            EXEC SQL
  307.              FETCH CURS-VC0VISUREBENI
  308.              INTO :VC00TAB17
  309.            END-EXEC
  310.  
  311.          IF SQLCODE NOT = 0 AND NOT = 100
  312.            MOVE SQLCODE                          TO Z-SQL
  313.            DISPLAY 'ERRORE IN FETCH DI CURS-VC0VISUREBENI'
  314.            DISPLAY 'SQLCODE: ' Z-SQL
  315.            DISPLAY 'FISCALE_BENI: ' FISCALE-BENI
  316.            DISPLAY 'COD_CONSERV_RICH: ' COD-CONSERV-RICH
  317.            DISPLAY 'TIPO_REC_BENI: ' TIPO-REC-BENI
  318.            ADD 1                                 TO DUMP
  319.          END-IF
  320.          .
  321.  
  322.       *--------------------------
  323.        CLOSE-CURS-VC0VISUREBENI.
  324.       *--------------------------
  325.            EXEC SQL
  326.              CLOSE CURS-FISCALE-VC0VISUREBENI
  327.            END-EXEC
  328.  
  329.          IF SQLCODE NOT = 0
  330.            MOVE SQLCODE                          TO Z-SQL
  331.            DISPLAY 'ERRORE IN CHIUSURA DI CURS-VC0VISUREBENI'
  332.            DISPLAY 'SQLCODE: ' Z-SQL
  333.            DISPLAY 'FISCALE_BENI: ' FISCALE-BENI
  334.            DISPLAY 'COD_CONSERV_RICH: ' COD-CONSERV-RICH
  335.            DISPLAY 'TIPO_REC_BENI: ' TIPO-REC-BENI
  336.            ADD 1                                 TO DUMP
  337.          END-IF
  338.          .
  339.  
  340.       *----------------
  341.        LEGGI-FILERICH.
  342.       *----------------
  343.          READ FILERICH INTO W-REC-RICHIESTE
  344.            AT END MOVE 1 TO EOF-FILERICH
  345.            NOT AT END
  346.            ADD 1                                 TO CONT-RIGHE-FILERICH
  347.          .
  348.  
  349.       *----------------
  350.        SCRIVI-FILEIMM.
  351.       *----------------
  352.         WRITE REC-IMMOB FROM REC-FILEIMM
  353.         ADD 1                                    TO CONT-RIGHE-FILEIMM
  354.         .
  355.  
  356.       *-----------------
  357.        REPORT-FINE-PGM.
  358.       *-----------------
  359.          DISPLAY '*---------------- REPORT FINE-PGM ---------------------*'
  360.          DISPLAY 'LETTE 'CONT-RIGHE-FILERICH' RIGHE DA FILERICH;'
  361.          DISPLAY 'SCRITTE 'CONT-RIGHE-FILEIMM' RIGHE IN FILEIMM;'
  362.          DISPLAY 'TROVATI 'CONT-BENI-TOT' BENI IN TOTALE;'
  363.          DISPLAY 'ELABORATI 'CONT-BENI-NESSUN-ERRORE' BENI SENZA-ERRORI;'
  364.          DISPLAY '*------------------------------------------------------*'
  365.          .
  366.  
  367.       *----------
  368.        FINE-PGM.
  369.       *----------
  370.          CLOSE FILERICH
  371.                FILEIMM
  372.  
  373.          DISPLAY 'FINE PGM' NOME-PGM
  374.          GOBACK
  375.          .
  376. 
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!