PRTAN041

Stampa

Dettagli: Visite: 900

IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAN041.
*--------------------------------------------------------------*
*               PROGETTO RETTIFICHE                            *
*               -------------------                            *
* AUTORE       : FRANCO D'AMICO C.O.DI MARSALA                *
*                                                              *
* FUNZIONE     : SCELTA PARAMETRI PER ANNULLAMENTO DA PRESCR. *
*   LA PRESCRIZIONE DELLE RETT.PASSIVE DA DM PASSIVO E' 10 ANNI*
* PGM CHIAMANTI : PRTAN01                                      *
* PGM CHIAMATI : PRTUT02                                      *
* MAPPE         : MRTAN041                                     *
* AREA DI INPUT : CRTMN01                                      *
*                                                              *
*--------------------------------------------------------------*

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.

INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MRTAN04 ASSIGN TO WORKSTATION-MRTAN04
ORGANIZATION     IS TRANSACTION
ACCESS           IS DYNAMIC
RELATIVE KEY IS CONTSUBF
FILE STATUS      IS F-STATUS.
SELECT SRTAN041 ASSIGN TO FORMATFILE-SRTAN041
ACCESS MODE     IS SEQUENTIAL
FILE STATUS      IS F-STATUS.

DATA DIVISION.

FILE SECTION.
FD   MRTAN04
LABEL RECORD IS omitted.
01   REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAN04.
FD SRTAN041.
01 REC-STAMPA    PIC X(132).
COPY DDS-ALL-FORMAT OF SRTAN041.

*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
EXEC SQL
INCLUDE SQLCA
END-EXEC.
01 SQLERR        PIC 9(5).
01 CONTSUBF      PIC 9(5).
77 F-STATUS       PIC XX.
01 IND-ON          PIC 1 VALUE B"1".
01 IND-OFF         PIC 1 VALUE B"0".
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAN04.
01 WDATA         PIC S9(8).
01 SUOPERI.
03 ANNO       PIC 9(4).
03 MESE       PIC 99.
01 MIOPERI.
03 MESE       PIC 99.
03 ANNO       PIC 9(4).
01 WMPERI.
03 WMANNO PIC 9(4).
03 WMMESE PIC 99.
01 WDAEMI.
03 GG        PIC 99.
03 MM        PIC 99.
03 AA        PIC 9(4).
01 WDAEMI2.
03 AA        PIC 9(4).
03 MM        PIC 99.
03 GG        PIC 99.
01 WIMPRETT        PIC S9(11)V9(2).
01 WTOTRETT        PIC S9(11).
01 WIMPDA2         PIC X(10).
01 WIMPA2          PIC X(10).
01 WIMPDA3         PIC 9(9).
01 WIMPA3          PIC 9(9).
01 WDIFF1          PIC S9(6).
01 WDIFF2          PIC S9(6).
01 WRETT           PIC S9(2).
01 MIA-AREA.
03 WD10PER2       PIC S9(6).
03 WITER           PIC XX.
03 STRINGA         PIC X(1000).
03 POSTO           PIC 9(4).
03 CM2-MATRICOLA   PIC S9(10).
03 CM2-D10PER      PIC S9(6).
03 CM2-PROPER      PIC S9(2).
03 FISSO2          PIC XX.
03 FISSO3          PIC XX.
03 FISSO1          PIC X.
03 WRETTA          PIC S9.
03 WRETTP          PIC S9.
03 WFLAGVAR        PIC S9.
03 WSALCA          PIC S9(10)V9(2).
03 WSALDO1         PIC S9(10)V9(2).
03 WSANZI          PIC S9(10)V9(2).
03 WIMPRE          PIC S9(13)V9(2).
03 WPASS          PIC X.
03 WIMPDA         PIC S9(9).
03 WIMPA          PIC S9(9).
03 WMATRICOLA     PIC S9(10).
03 WD10PER        PIC S9(6).
03 WGUIDA         PIC 9.
03 WGRP           PIC X.
03 WAPT           PIC X.
03 WNUM           PIC Z(7).
01 SCELTAFATTA      PIC 9.
01 WFINE            PIC 9.
01 WSUBAREA.
03 WMATR      PIC S9(10).
03 WPERI.
05 MM       PIC S99.
05 AA       PIC S9(4).
03 WPROG      PIC S9(2).
01 WPERI2.
05 AA       PIC S9(4).
05 MM       PIC S99.
01 WPERI3        PIC S9(6).
01 RIGA          PIC 99.
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01.
MAIN.
MOVE SPACES TO CM1-MSG.
MOVE CM1-DATAG TO WDATA.
MOVE 0 TO CONTSUBF.
OPEN I-O MRTAN04.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAN04" TO CM1-ERRFILE
MOVE "PRTAN04" TO CM1-ERRPGM
MOVE 1         TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
MOVE IND-OFF TO IN12 OF MSELEZ-I-INDIC.
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL IN12 OF MSELEZ-I-INDIC = IND-ON.
IF IN12 OF MSELEZ-I-INDIC = IND-ON
GO TO FINE
END-IF.

FINE.
MOVE SPACES TO CM1-MSG.
CLOSE MRTAN04.
GOBACK.

SEQUENZA.
CLOSE MRTAN04.
OPEN I-O MRTAN04.
MOVE 0 TO CONTSUBF.
MOVE CM1-MSG TO MMSG OF MSELEZ-O.
MOVE IND-OFF TO IN12 OF MSELEZ-I-INDIC.
IF MSEGNO1 OF MSELEZ-O = LOW-VALUE OR SPACES
MOVE "+" TO MSEGNO1 OF MSELEZ-O.
IF MSEGNO2 OF MSELEZ-O = LOW-VALUE OR SPACES
MOVE "+" TO MSEGNO2 OF MSELEZ-O.
MOVE "N" TO MGUIDA1 OF MSELEZ-O.
MOVE "S" TO MGRP OF MSELEZ-O.
MOVE "T" TO MAPT OF MSELEZ-O.
MOVE 0 TO MGUIDA2 OF MSELEZ-O MRETT OF MSELEZ-O
MOVE 0 TO CM1-MATRICOLA CM1-D10PER WD10PER
WRITE REC-VIDEO FORMAT "MFONDO".
MOVE "SEL.ANN.PER SUPERAMENTO TERMINI PREVISTI" TO MTIT
* MOVE " SELEZIONE ANNULLAMENTO DA PRESCRIZIONE" TO MTIT
MOVE IND-OFF TO IN90 OF MSELEZ-O-INDIC
WRITE REC-VIDEO FORMAT "MSELEZ"
INDICATORS ARE AREA-INDIC.
READ MRTAN04 FORMAT "MSELEZ"
INDICATORS ARE AREA-INDIC.
IF IN12 OF MSELEZ-I-INDIC = IND-ON
MOVE SPACES TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
MOVE SPACES TO MMSG OF MSELEZ-O.
IF MMATR OF MSELEZ-I IS NUMERIC
MOVE MMATR OF MSELEZ-I TO CM1-MATRICOLA
END-IF.
IF MMESEDA OF MSELEZ-I IS NUMERIC AND MANNODA OF MSELEZ-I
IS NUMERIC
MOVE MMESEDA OF MSELEZ-I TO WMMESE
MOVE MANNODA OF MSELEZ-I TO WMANNO
MOVE WMPERI TO CM1-D10PER
END-IF.
IF MMESEA OF MSELEZ-I IS NUMERIC AND MANNOA OF MSELEZ-I
IS NUMERIC
MOVE MMESEA OF MSELEZ-I TO WMMESE
MOVE MANNOA OF MSELEZ-I TO WMANNO
MOVE WMPERI TO WD10PER
END-IF.
IF WD10PER < CM1-D10PER AND WD10PER > 0
MOVE "RICHIESTA PRIVA DI LOGICA !" TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
IF MIMPDA OF MSELEZ-I IS NUMERIC
MOVE MIMPDA OF MSELEZ-I TO WIMPDA
IF MSEGNO1 OF MSELEZ-I IS = '-'
COMPUTE WIMPDA = WIMPDA * -1
END-IF
ELSE
MOVE -999999999 TO WIMPDA
END-IF.
IF MIMPA OF MSELEZ-I IS NUMERIC
MOVE MIMPA OF MSELEZ-I TO WIMPA
IF MSEGNO2 OF MSELEZ-I IS = '-'
COMPUTE WIMPA = WIMPA * -1
END-IF
ELSE
MOVE 999999999 TO WIMPA
END-IF.
IF WIMPDA < WIMPDA
MOVE "RICHIESTA PRIVA DI LOGICA !" TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
MOVE MGRP OF MSELEZ-I TO WGRP.
MOVE MRETT OF MSELEZ-I TO WRETT.
MOVE MGUIDA1 OF MSELEZ-I TO WPASS.
MOVE MGUIDA2 OF MSELEZ-I TO WGUIDA.
MOVE MAPT OF MSELEZ-I TO WAPT.
MOVE WIMPDA TO WIMPDA3.
MOVE WIMPA TO WIMPA3.
IF WIMPDA < 0
STRING "-" WIMPDA3 DELIMITED BY SIZE INTO WIMPDA2
ELSE
MOVE WIMPDA3 TO WIMPDA2
END-IF.
IF WIMPA < 0
STRING "-" WIMPA3 DELIMITED BY SIZE INTO WIMPA2
ELSE
MOVE WIMPA3 TO WIMPA2
END-IF.
MOVE CM1-D10PER TO WD10PER2.
MOVE '"' TO FISSO1.
MOVE '"%' TO FISSO2.
MOVE '%"' TO FISSO3.
PERFORM PASSA-DATI THRU EX-PASSA-DATI.
IF CONTSUBF = 0
MOVE "NESSUNA RETTIFICA SELEZIONATA" TO CM1-MSG
END-IF.
IF CONTSUBF > 0
MOVE IND-OFF TO IN12 OF MC021CTL-I-INDIC
MOVE CONTSUBF TO WNUM
MOVE SPACES TO MC02MSG OF MC021CODA-O
STRING "RETT. SELEZIONATE N° " WNUM
" - Scegli e premi INVIO - F11 per Tutte"
DELIMITED BY SIZE INTO MC02MSG OF MC021CODA-O
MOVE 1 TO CONTSUBF
PERFORM SCRIVI-LEGGI THRU EX-SCRIVI-LEGGI
UNTIL IN12 OF MC021CTL-I-INDIC = IND-ON
END-IF.
EX-SEQUENZA. EXIT.

PASSA-DATI.
MOVE SPACES TO STRINGA.
COMPUTE WDIFF1 = CM1-D10PER + 500
COMPUTE WDIFF2 = WD10PER + 500
COMPUTE POSTO = 1.
* RTTIRET = 91 PER LE RETT.PASSIVE DA DM PASSIVO
* IN TAL CASO LA PRESCRIZIONE E' DI 10 ANNI
STRING "SELECT RTMATAZI, RTD10PER, RTPROPER, RTRETTA, "
"RTRETTP, RTITER, RTSALCA, RTSALDO1, RTSANZI, "
" RTIMPRE, RTFLAGVAR FROM ARTDEFPRI WHERE "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " ((RTTIRET = 91 AND (RTD10PER + 1000) < "
CM1-DATAG(1:6) ") OR (RTTIRET <> 91 AND "
* " (RTD10PER < " WCM-DATA "))"
" (RTD10PER + 500) < " CM1-DATAG(1:6)"))"
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
STRING " AND RTIMPRE BETWEEN " WIMPDA2 " AND " WIMPA2
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTELABCAL = 0 AND RTFLSTAT = 0 "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTCODDEF = 0 AND RTFLCONS = 0 "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTITER <> " FISSO1 "RP" FISSO1
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTITER <> " FISSO1 "RC" FISSO1
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
IF WDIFF1 > 500
STRING " AND RTD10PER >= " CM1-D10PER
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WDIFF2 > 500
STRING " AND RTD10PER <= " WD10PER
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF CM1-MATRICOLA > 0
STRING " AND RTMATAZI = " CM1-MATRICOLA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WRETT > 0
STRING " AND RTTIRET = " WRETT
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WAPT = "A"
STRING " AND RTRETTA = 1 "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WAPT = "P"
STRING " AND RTRETTP = 1 "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WPASS = "S"
STRING " AND DIGITS(RTMATAZI) LIKE " FISSO2 WGUIDA FISSO1
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WGRP = "S"
STRING " AND (DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(1:1)
FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(2:1) FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(3:1) FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(4:1) FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(5:1) FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(6:1) FISSO1
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
STRING " OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(7:1)
FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(8:1) FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(9:1) FISSO1
" OR DIGITS(RTMATAZI) LIKE " FISSO2 CM1-GUIDA(10:1)
FISSO1 ")"
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
* DISPLAY STRINGA(1:600)
EXEC SQL
PREPARE S1 FROM :STRINGA
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.6 PGM PRTAN04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-PASSA-DATI
END-IF
EXEC SQL
DECLARE C1 CURSOR FOR S1
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.7 PGM PRTAN04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-PASSA-DATI
END-IF
EXEC SQL
OPEN C1
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.8 PGM PRTAN04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-PASSA-DATI
END-IF.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL
FETCH C1 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR
END-EXEC
IF SQLCODE = 0
PERFORM SCRIVI-MAPPA THRU EX-SCRIVI-MAPPA
END-IF
END-PERFORM.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.9 PGM PRTAN04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-PASSA-DATI
END-IF
EXEC SQL
CLOSE C1
END-EXEC.
EX-PASSA-DATI. EXIT.

SCRIVI-MAPPA.
ADD 1 TO CONTSUBF
IF CONTSUBF > 9990
GO TO EX-SCRIVI-MAPPA
END-IF.
MOVE CM2-MATRICOLA TO MC021MATR OF MC021-O
MOVE CM2-D10PER TO SUOPERI
MOVE CORRESPONDING SUOPERI TO MIOPERI
MOVE MIOPERI TO MC021PER OF MC021-O
MOVE CM2-PROPER TO MC21PRG OF MC021-O
IF WRETTA = 1
MOVE "A" TO MC021TIP OF MC021-O
END-IF
IF WRETTP = 1
MOVE "P" TO MC021TIP OF MC021-O
END-IF
MOVE WITER TO MC021ITER OF MC021-O
* RTFLAGVAR > 1 = RETTIFICA VARIATA E NON RICALCOLATA
* RTFLAGVAR A 1 = RETTIFICA VARIATA E RICALCOLATA
IF WFLAGVAR > 1
MOVE 0 TO MC021DEN OF MC021-O MC021CALC OF MC021-O
MC021DIFF OF MC021-O
ELSE
COMPUTE MC021DEN OF MC021-O = WSALCA - WSALDO1
MOVE WSANZI TO MC021CALC OF MC021-O
IF WIMPRE NOT GREATER 0 AND WSALDO1 < 0
MOVE WSALCA TO MC021DIFF OF MC021-O
ELSE
MOVE WIMPRE TO MC021DIFF OF MC021-O
END-IF
END-IF
WRITE SUBFILE REC-VIDEO FORMAT "MC021"
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAN04" TO CM1-ERRFILE
MOVE "PRTAN04" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-SCRIVI-MAPPA. EXIT.

SCRIVI-LEGGI.
MOVE IND-OFF TO IN73 IN74.
MOVE IND-OFF TO IN12 OF MC021CTL-I-INDIC
MOVE IND-OFF TO IN05 OF MC021CTL-I-INDIC
WRITE REC-VIDEO FORMAT "MC021CODA".
MOVE CONTSUBF TO MC021NREC OF MC021CTL-O
MOVE CM1-DATACHIARO TO MC021OGGI.
*     MOVE "APPOSIZIONE FLAG ANNULLAMENTO DA PRESCRIZIONE"
MOVE "FLAG ANNULL. PER SUPERAMENTO TERMINI PREVISTI"
TO MTIT2
WRITE REC-VIDEO FORMAT "MC021CTL"
READ MRTAN04 FORMAT "MC021CTL"
INDICATORS ARE MC021CTL-I-INDIC.
STRING "RETT. SELEZIONATE N° " WNUM
" - Scegli e premi INVIO - F11 per Tutte"
DELIMITED BY SIZE INTO MC02MSG OF MC021CODA-O
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAN04" TO CM1-ERRFILE
MOVE "PRTAN04" TO CM1-ERRPGM
MOVE 3         TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
IF IN12 OF MC021CTL-I-INDIC = IND-ON
GO TO EX-SCRIVI-LEGGI
END-IF.
* COL TASTO F5 PREPARO LA STAMPA DEL SUBFILE
IF IN05 OF MC021CTL-I-INDIC = IND-ON
MOVE IND-OFF TO IN05 OF MC021CTL-I-INDIC
COMPUTE RIGA = 60
PERFORM STAMPA THRU EX-STAMPA
MOVE SPACES TO MC02MSG OF MC021CODA-O
MOVE "                 PRONTA CODA DI STAMPA SRTAN041"
TO MC02MSG OF MC021CODA-O
GO TO EX-SCRIVI-LEGGI
END-IF.
* COL TASTO F2 CONSULTO LA RETTIFICA
IF IN02 OF MC021CTL-I-INDIC = IND-ON
MOVE IND-OFF TO IN02 OF MC021CTL-I-INDIC
PERFORM DETTAGLIO THRU EX-DETTAGLIO
STRING "RETT. SELEZIONATE N° " WNUM
" - Scegli e premi INVIO - F11 per Tutte"
DELIMITED BY SIZE INTO MC02MSG OF MC021CODA-O
GO TO EX-SCRIVI-LEGGI
END-IF.
* COL TASTO F11 CONFERMO I RECORD SELEZIONATI
IF IN11 OF MC021CTL-I-INDIC = IND-ON
PERFORM CONFERMA THRU EX-CONFERMA
MOVE "ELABORAZIONE COMPLETATA" TO CM1-MSG
MOVE IND-ON TO IN12 OF MC021CTL-I-INDIC
ELSE
* COL TASTO INVIO OPERO UNA SCELTA MANUALE
PERFORM SCELTA THRU EX-SCELTA UNTIL F-STATUS NOT = "00"
IF SCELTAFATTA = 9
MOVE 0 TO SCELTAFATTA
MOVE "ELABORAZIONE COMPLETATA" TO CM1-MSG
MOVE IND-ON TO IN12 OF MC021CTL-I-INDIC
END-IF
END-IF.
EX-SCRIVI-LEGGI.
EXIT.

DETTAGLIO.
READ SUBFILE MRTAN04 MODIFIED INTO WSUBAREA FORMAT "MC021"
AT END
MOVE 0 TO WFINE
NOT AT END
MOVE 1 TO WFINE.
IF WFINE = 1
MOVE SPACES TO MC21SC OF MC021-I
REWRITE SUBFILE REC-VIDEO FORMAT IS "MC021"
MOVE WMATR TO CM1-MATRICOLA
MOVE WPROG TO CM1-PROPER
MOVE CORRESPONDING WPERI TO WPERI2
MOVE WPERI2 TO CM1-D10PER
CALL "PRTDY02" USING AREA-MN01
END-IF.
EX-DETTAGLIO. EXIT.

SCELTA.
READ SUBFILE MRTAN04 MODIFIED INTO WSUBAREA FORMAT "MC021"
AT END
MOVE 0 TO WFINE
NOT AT END
MOVE 1 TO WFINE.
IF WFINE = 1 AND MC21SC OF MC021-I NOT = SPACES
MOVE 9 TO SCELTAFATTA
MOVE IND-ON TO IN73
MOVE SPACES TO MC21SC OF MC021-I
REWRITE SUBFILE REC-VIDEO FORMAT IS "MC021"
INDICATORS ARE MC021-O-INDIC
MOVE CORRESPONDING WPERI TO WPERI2
MOVE WPERI2 TO WPERI3
EXEC SQL
UPDATE ARTDEFPRI SET RTFLSTAT = 6,
RTDTSTAT = :WDATA
WHERE RTMATAZI = :WMATR
AND   RTD10PER = :WPERI3
AND   RTPROPER = :WPROG
*           AND   RTFLAGVAR < 2
AND RTFLSTAT = 0
AND RTFLCONS = 0
AND RTELABCAL = 0
END-EXEC
END-IF
IF SQLCODE NOT = 0
IF SQLCODE NOT = 100
EXEC SQL ROLLBACK END-EXEC
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
STRING "ERR.SQL(" SQLERR ")"
DELIMITED BY SIZE INTO CM1-MSG
MOVE "ARTDEFPRI" TO CM1-ERRFILE
MOVE "PRTAN04" TO CM1-ERRPGM
MOVE 4        TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
ELSE
EXEC SQL ROLLBACK END-EXEC
END-IF
ELSE
EXEC SQL COMMIT END-EXEC
MOVE SPACES TO CM1-MSG
END-IF.
EX-SCELTA. EXIT.

STAMPA.
EXEC SQL
OPEN C1
END-EXEC
MOVE 0 TO WTOTRETT WIMPRETT.
OPEN OUTPUT SRTAN041
EXEC SQL
FETCH C1 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR
END-EXEC.
TESTATA.
IF RIGA > 56
MOVE 1 TO RIGA
STRING "RETTIFICHE SELEZIONATE PER ANNULLAMENTO "
"IN DATA " CM1-DATACHIARO DELIMITED BY SIZE INTO SMSG
MOVE CM1-DENOM-SEDE TO SSEDE
IF WGRP = "S" AND WPASS NOT = "S"
STRING "GRUPPO DI PROCESSO N. " CM1-GRUPPO
DELIMITED BY SIZE INTO SGRUPPO
ELSE
MOVE SPACES TO SGRUPPO
END-IF
WRITE REC-STAMPA FROM TESTATA-O
FORMAT IS "TESTATA"
END-IF.
PERFORM UNTIL SQLCODE NOT = 0
IF RIGA > 56
GO TO TESTATA
END-IF
MOVE CM2-MATRICOLA TO SMATR
IF WRETTA = 1
MOVE "A" TO STIPO
END-IF
IF WRETTP = 1
MOVE "P" TO STIPO
END-IF
MOVE WITER   TO SITER
MOVE CM2-D10PER TO SUOPERI
MOVE CORRESPONDING SUOPERI TO MIOPERI
STRING MIOPERI(1:2) "/" MIOPERI(3:4) DELIMITED BY SIZE
INTO SPERI
MOVE WSANZI TO SSANZ
COMPUTE SDIFF = WSALCA - WSALDO1
* RTFLAGVAR > 1 = RETTIFICA VARIATA E NON RICALCOLATA
* RTFLAGVAR A 1 = RETTIFICA VARIATA E RICALCOLATA
*          IF WFLAGVAR > 1
*           MOVE 0 TO SSALDO
*          ELSE
IF WIMPRE NOT GREATER 0 AND WSALDO1 < 0
MOVE WSALCA TO SSALDO
ADD WSALCA   TO WIMPRETT
ELSE
MOVE WIMPRE TO SSALDO
ADD WIMPRE TO WIMPRETT
END-IF
*          END-IF
ADD 1 TO WTOTRETT RIGA
WRITE REC-STAMPA FROM CORPO-O
FORMAT IS "CORPO"
EXEC SQL
FETCH C1 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR
END-EXEC
END-PERFORM.
EXEC SQL
CLOSE C1
END-EXEC
WRITE REC-STAMPA
FORMAT IS "FINALE"
MOVE WTOTRETT TO STOTRETT
MOVE WIMPRETT TO SIMPRETT
WRITE REC-STAMPA FROM TOTALI-O
FORMAT IS "TOTALI"
CLOSE SRTAN041.
EX-STAMPA. EXIT.

CONFERMA.
EXEC SQL
OPEN C1
END-EXEC
EXEC SQL
FETCH C1 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR
END-EXEC
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL
UPDATE ARTDEFPRI SET RTFLSTAT = 6,
RTDTSTAT = :WDATA
WHERE RTMATAZI = :CM2-MATRICOLA
AND   RTD10PER = :CM2-D10PER
AND   RTPROPER = :CM2-PROPER
*           AND   RTFLAGVAR < 2
AND RTFLSTAT = 0
AND RTFLCONS = 0
AND RTELABCAL = 0
END-EXEC
IF SQLCODE = 0
EXEC SQL COMMIT HOLD END-EXEC
ELSE
EXEC SQL ROLLBACK END-EXEC
END-IF
EXEC SQL
FETCH C1 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR
END-EXEC
END-PERFORM.
IF SQLCODE NOT = 0
IF SQLCODE NOT = 100
EXEC SQL ROLLBACK END-EXEC
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
STRING "ERR.SQL(" SQLERR ")"
DELIMITED BY SIZE INTO CM1-MSG
MOVE "ARTDEFPRI" TO CM1-ERRFILE
MOVE "PRTAN04" TO CM1-ERRPGM
MOVE 5         TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
ELSE
EXEC SQL ROLLBACK END-EXEC
END-IF.
EXEC SQL CLOSE C1 END-EXEC.
EX-CONFERMA. EXIT.