API tools faq
paste
Advertisement
Guest User

Untitled

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