API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 10th, 2017
86
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 13.38 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-ANNO                        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) VALUE ZERO.
  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 AREA DATI BENE
  105.        COPY VC00VIDF.
  106.  
  107.       * TRACCIATO FILEIMM
  108.        COPY STAIMM1C.
  109.  
  110.       * ROUTINES
  111.        01 STAVE01R                               PIC X(08) VALUE 'STAVE01R'.
  112.        COPY STAVE01C.
  113.  
  114.        PROCEDURE DIVISION.
  115.  
  116.       *------
  117.        MAIN.
  118.       *------
  119.          PERFORM INIZIALIZZA
  120.  
  121.          PERFORM LEGGI-FILERICH
  122.          PERFORM CONTROLLA-FILERICH UNTIL EOF-FILERICH = 1
  123.  
  124.          PERFORM REPORT-FINE-PGM
  125.          PERFORM FINE-PGM
  126.          .
  127.  
  128.       *-------------
  129.        INIZIALIZZA.
  130.       *-------------
  131.          DISPLAY 'INIZIO PGM ' NOME-PGM
  132.  
  133.          OPEN INPUT  FILERICH
  134.               OUTPUT FILEIMM
  135.  
  136.          ACCEPT SKEDA-PARAMETRO
  137.          MOVE SK-DATA-OPE                        TO DATA-COMODO
  138.  
  139.          MOVE DATA-COMODO-ANNO                   TO DATA-DB2-ANNO
  140.          MOVE DATA-COMODO-MESE                   TO DATA-DB2-MESE
  141.          MOVE DATA-COMODO-GIORNO                 TO DATA-DB2-GIORNO
  142.          MOVE '-'                                TO DATA-DB2-TRAT1
  143.          MOVE '-'                                TO DATA-DB2-TRAT2
  144.          .
  145.  
  146.       *--------------------
  147.        CONTROLLA-FILERICH.
  148.       *--------------------
  149.          PERFORM OPEN-CURS-VC0VISUREBENI
  150.          PERFORM FETCH-CURS-VC0VISUREBENI
  151.          PERFORM OTTIENI-DATI
  152.            UNTIL SQLCODE = 100
  153.          PERFORM CLOSE-CURS-VC0VISUREBENI
  154.  
  155.          PERFORM LEGGI-FILERICH
  156.          .
  157.  
  158.       *--------------
  159.        OTTIENI-DATI.
  160.       *--------------
  161.          PERFORM SELECT-VC0IMMOBILI
  162.          MOVE SQLCODE                            TO SQLCODE-VC0IMMOBILI
  163.          PERFORM SELECT-VC0VISUREANAG
  164.          MOVE SQLCODE                            TO SQLCODE-VC0VISUREANAG
  165.          MOVE AREA-DATI-BENI                     TO VC00VIDF
  166.          PERFORM CHIAMA-STAVE01E
  167.          PERFORM CONTROLLA-ERRORI
  168.          IF SW-NESSUN-ERRORE = 1
  169.            PERFORM VALORIZZA-REC-IMMOB
  170.            PERFORM SCRIVI-FILEIMM
  171.            INITIALIZE SW-NESSUN-ERRORE
  172.          END-IF
  173.          ADD 1 TO CONT-BENI-TOT
  174.  
  175.          PERFORM FETCH-CURS-VC0VISUREBENI
  176.          .
  177.  
  178.       *-----------------
  179.        CHIAMA-STAVE01R.
  180.       *-----------------
  181.          INITIALIZE AREA-STAVE01R
  182.          MOVE 'CON'                              TO AZIONE-INPUT-STAVE01R
  183.          MOVE COD-CONS-RICH                      TO COD-CONS-INPUT-STAVE01R
  184.  
  185.          CALL STAVE01R USING STAVE01C
  186.          .
  187.  
  188.       *------------------
  189.        CONTROLLA-ERRORI.
  190.       *------------------
  191.          EVALUATE TRUE
  192.          WHEN RETURNCODE-RC-STAVE01R = 4
  193.             DISPLAY MESSAGE-RC-STAVE01R
  194.             DISPLAY 'ERRORE IN ' FISCALE-RICH' E ' COD-CONS-RICH
  195.          WHEN RETURNCODE-RC-STAVE01R = 8
  196.          WHEN RETURNCODE-RC-STAVE01R = 12
  197.             DISPLAY MESSAGE-RC-STAVE01R
  198.             ADD 1                                TO DUMP
  199.          WHEN SQLCODE-VC0IMMOBILI = 100
  200.             DISPLAY 'SELECT VUOTO IN VC0IMMOBILI PER 'FISCALE-RICH' E 'COD-CONS-RICH
  201.          WHEN SQLCODE-VC0VISUREANAG = 100
  202.             DISPLAY 'SELECT VUOTO IN VC0VISUREANAG PER 'FISCALE-RICH' E 'COD-CONS-RICH
  203.          WHEN OTHER
  204.            MOVE 1                                TO SW-NESSUN-ERRORE
  205.            ADD 1                                 TO CONT-BENI-NESSUN-ERRORE
  206.          END-EVALUATE
  207.          .
  208.  
  209.       *--------------------
  210.        SELECT-VC0IMMOBILI.
  211.       *--------------------
  212.          INITIALIZE VC00TAB60
  213.  
  214.          MOVE FISCALE-BENI                       TO COD-FISC-IMM
  215.          MOVE COD-CONSERV-BENI                   TO COD-CONS-IMM OF VC0IMMOBILI
  216.          MOVE COD-BENE-BENI                      TO FORN-COD-BENE-IMM
  217.  
  218.            EXEC SQL
  219.              SELECT *
  220.                INTO :VC00TA60
  221.                FROM VC0IMMOBILI
  222.                WHERE COD_FISC_IMM  = :COD-FISC-IMM
  223.                AND   COD_CONS_IMM  = :COD-CONS-IMM OF VC0IMMOBILI
  224.                AND   FORN_COD_BENE_IMM  = :FORN-COD-BENE-IMM
  225.            END-EXEC
  226.  
  227.          IF SQLCODE NOT = ZERO AND NOT = 100
  228.            MOVE SQLCODE                          TO Z-SQL
  229.            DISPLAY 'ERRORE IN SELECT IN VC0IMMOBILI'
  230.            DISPLAY 'SQLCODE: ' Z-SQL
  231.            DISPLAY 'COD_FISC_IMM:' COD-FISC-IMM
  232.            DISPLAY 'COD_CONS_IMM: ' COD-CONS-IMM OF VC0IMMOBILI
  233.            DISPLAY 'FORN_COD_BENE_IMM: ' FORN-COD-BENE-IMM
  234.            ADD 1                                 TO DUMP
  235.          END-IF
  236.          .
  237.  
  238.       *----------------------
  239.        SELECT-VC0VISUREANAG.
  240.       *----------------------
  241.          INITIALIZE VC00TAB16
  242.  
  243.          MOVE FISCALE-BENI                       TO FISCALE-ANAG
  244.          MOVE COD-CONSERV-BENI                   TO COD-CONSERV-ANAG
  245.  
  246.            EXEC SQL
  247.              SELECT *
  248.                INTO :VC00TA16
  249.                FROM VC0VISUREANAG
  250.                WHERE FISCALE_ANAG   = :FISCALE-ANAG
  251.                AND   COD_CONSERV_ANAG = :COD-CONSERV-ANAG
  252.            END-EXEC
  253.  
  254.          IF SQLCODE NOT = ZERO AND NOT = 100
  255.            MOVE SQLCODE                          TO Z-SQL
  256.            DISPLAY 'ERRORE IN SELECT IN VC0IMMOBILI'
  257.            DISPLAY 'SQLCODE: ' Z-SQL
  258.            DISPLAY 'FISCALE_ANAG: ' FISCALE-ANAG
  259.            DISPLAY 'COD_CONSERV_ANAG: ' COD-CONSERV-ANAG
  260.            ADD 1                                 TO DUMP
  261.          END-IF
  262.          .
  263.  
  264.       *---------------------
  265.        VALORIZZA-REC-IMMOB.
  266.       *---------------------
  267.          MOVE FISCALE-RICH                       TO FISCALE-IMM
  268.          MOVE NOME-ANAG   OF VC0VISUREANAG       TO NOME-ANAG   OF REC-IMMOB
  269.          MOVE COD-CONS-RICH                      TO COD-CONS-IMM
  270.          MOVE DES-CONS-OUTPUT-STAVE01R           TO DES-CONS-IMM
  271.          MOVE SEZIONE-IMM OF VC0IMMOBILI         TO SEZIONE-IMM OF REC-IMMOB
  272.          MOVE FOGLIO-IMM  OF VC0IMMOBILI         TO FOGLIO-IMM  OF REC-IMMOB
  273.          MOVE MAPPALE-IMM OF VC0IMMOBILI         TO MAPPALE-IMM OF REC-IMMOB
  274.          MOVE COMUNE-IMM  OF VC0IMMOBILI         TO COMUNE-IMM  OF REC-IMMOB
  275.          MOVE PROVINCIA-IMM                      TO PROV-IMM
  276.          MOVE DATA-DB2                           TO DATA-OPE
  277.          MOVE SK-MATR-OPE                        TO MATR-OPE
  278.          MOVE VD02-TIPO-DEL-BENE                 TO TIPO-BENE
  279.          MOVE VD02-VAL-RENDITA-CAT               TO VAL-RENDITA-CAT
  280.          .
  281.  
  282.       *-------------------------
  283.        OPEN-CURS-VC0VISUREBENI.
  284.       *-------------------------
  285.          INITIALIZE VC00TAB17
  286.  
  287.          MOVE FISCALE-RICH                       TO FISCALE-BENI
  288.          MOVE COD-CONS-RICH                      TO COD-CONSERV-BENI
  289.          MOVE 2                                  TO TIPO-REC-BENI
  290.  
  291.            EXEC SQL
  292.              OPEN CURS-VC0VISUREBENI
  293.            END-EXEC
  294.  
  295.          IF SQLCODE NOT = 0
  296.            MOVE SQLCODE                          TO Z-SQL
  297.            DISPLAY 'ERRORE IN APERTURA DI CURS-VC0VISUREBENI'
  298.            DISPLAY 'SQLCODE: ' Z-SQL
  299.            DISPLAY 'FISCALE_BENI: ' FISCALE-BENI
  300.            DISPLAY 'COD_CONSERV_RICH: ' COD-CONSERV-RICH
  301.            DISPLAY 'TIPO_REC_BENI: ' TIPO-REC-BENI
  302.            ADD 1                                 TO DUMP
  303.          END-IF
  304.          .
  305.  
  306.       *--------------------------
  307.        FETCH-CURS-VC0VISUREBENI.
  308.       *--------------------------
  309.            EXEC SQL
  310.              FETCH CURS-VC0VISUREBENI
  311.              INTO :VC00TAB17
  312.            END-EXEC
  313.  
  314.          IF SQLCODE NOT = 0 AND NOT = 100
  315.            MOVE SQLCODE                          TO Z-SQL
  316.            DISPLAY 'ERRORE IN FETCH DI CURS-VC0VISUREBENI'
  317.            DISPLAY 'SQLCODE: ' Z-SQL
  318.            DISPLAY 'FISCALE_BENI: ' FISCALE-BENI
  319.            DISPLAY 'COD_CONSERV_RICH: ' COD-CONSERV-RICH
  320.            DISPLAY 'TIPO_REC_BENI: ' TIPO-REC-BENI
  321.            ADD 1                                 TO DUMP
  322.          END-IF
  323.          .
  324.  
  325.       *--------------------------
  326.        CLOSE-CURS-VC0VISUREBENI.
  327.       *--------------------------
  328.            EXEC SQL
  329.              CLOSE CURS-FISCALE-VC0VISUREBENI
  330.            END-EXEC
  331.  
  332.          IF SQLCODE NOT = 0
  333.            MOVE SQLCODE                          TO Z-SQL
  334.            DISPLAY 'ERRORE IN CHIUSURA DI CURS-VC0VISUREBENI'
  335.            DISPLAY 'SQLCODE: ' Z-SQL
  336.            DISPLAY 'FISCALE_BENI: ' FISCALE-BENI
  337.            DISPLAY 'COD_CONSERV_RICH: ' COD-CONSERV-RICH
  338.            DISPLAY 'TIPO_REC_BENI: ' TIPO-REC-BENI
  339.            ADD 1                                 TO DUMP
  340.          END-IF
  341.          .
  342.  
  343.       *----------------
  344.        LEGGI-FILERICH.
  345.       *----------------
  346.          READ FILERICH INTO W-REC-RICHIESTE
  347.            AT END MOVE 1 TO EOF-FILERICH
  348.            NOT AT END
  349.            ADD 1                                 TO CONT-RIGHE-FILERICH
  350.          .
  351.  
  352.       *----------------
  353.        SCRIVI-FILEIMM.
  354.       *----------------
  355.         WRITE REC-IMMOB FROM REC-FILEIMM
  356.         ADD 1                                    TO CONT-RIGHE-FILEIMM
  357.         .
  358.  
  359.       *-----------------
  360.        REPORT-FINE-PGM.
  361.       *-----------------
  362.          DISPLAY '*---------------- REPORT FINE-PGM ---------------------*'
  363.          DISPLAY 'LETTE 'CONT-RIGHE-FILERICH' RIGHE DA FILERICH;'
  364.          DISPLAY 'SCRITTE 'CONT-RIGHE-FILEIMM' RIGHE IN FILEIMM;'
  365.          DISPLAY 'TROVATI 'CONT-BENI-TOT' BENI IN TOTALE;'
  366.          DISPLAY 'ELABORATI 'CONT-BENI-NESSUN-ERRORE' BENI SENZA-ERRORI;'
  367.          DISPLAY '*------------------------------------------------------*'
  368.          .
  369.  
  370.       *----------
  371.        FINE-PGM.
  372.       *----------
  373.          CLOSE FILERICH
  374.                FILEIMM
  375.  
  376.          DISPLAY 'FINE PGM' NOME-PGM
  377.          GOBACK
  378.          .
  379. 
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!