API tools faq
paste
Advertisement
Guest User

Untitled

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