- Dettagli
- Visite: 860
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAN061.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : SCELTA PARAMETRI-CONSOLIDA ANNULLAMENTO *
* RETT.ANN.CON CODICE: IN STORIA CONSERVO UTENTE *
* CHE HA FATTO LA SELEZIONE ORIGINARIA *
* PGM CHIAMANTI : PRTAN01 *
* PGM CHIAMATI : PRTUT02 - PRTST21 *
* 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 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).
03 WTIP PIC X.
03 WITER2 PIC XX.
03 WDEN PIC S9(9)V9(2).
03 WCALC PIC S9(9)V9(2).
03 WDIFF PIC S9(11)V9(2).
03 WSCEL PIC X.
01 WPERI2.
05 AA PIC S9(4).
05 MM PIC S99.
01 WPERI3 PIC S9(6).
01 RIGA PIC 99.
01 WSRMATR PIC X(8).
01 WITSTO PIC XX VALUE "AN".
01 WMATR2 PIC S9(10).
01 WPROG2 PIC S9(2).
01 WNUMINAD PIC S9(4).
01 W-SRMATR PIC S9(8).
01 W-SROLD PIC S9(8).
01 W-SROLD2 REDEFINES W-SROLD PIC X(8).
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01.
MAIN.
MOVE SPACES TO CM1-MSG.
MOVE CM1-DATAG TO WDATA.
MOVE CM1-SRMATR TO WSRMATR W-SRMATR
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 "PRTAN06" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
MOVE IND-OFF TO IN12 OF MSELEZ-I-INDIC.
MOVE IND-ON TO IN90 OF MSELEZ-O-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.
WRITE REC-VIDEO FORMAT "MFONDO".
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.
MOVE 0 TO CM1-MATRICOLA CM1-D10PER WD10PER
MOVE " SELEZIONE PER CONSOLIDAMENTO ANNULLATE" TO MTIT
MOVE IND-ON 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 MGUIDA1 OF MSELEZ-I TO WPASS.
MOVE MGUIDA2 OF MSELEZ-I TO WGUIDA.
MOVE MGRP OF MSELEZ-I TO WGRP.
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.
STRING "SELECT RTMATAZI, RTD10PER, RTPROPER, RTRETTA, "
"RTRETTP, RTITER, RTSALCA, RTSALDO1, RTSANZI, RTIMPRE, "
"RTFLAGVAR, RTNUMINAD, RTRIFGIOR FROM ARTDEFPRI "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " WHERE RTIMPRE BETWEEN " WIMPDA2 " AND " WIMPA2
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTFLSTAT = 6 "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTCODDEF = 0 AND RTFLCONS = 0 "
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 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 PRTAN06"
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 PRTAN06"
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 PRTAN06"
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, :WNUMINAD, :W-SROLD
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 PRTAN06"
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 "PRTAN06" 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 " CONSOLIDAMENTO RETTIFICHE ANNULLATE" 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 "PRTAN06" 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
COMPUTE RIGA = 60
MOVE SPACES TO CM1-MSG
STRING "RETTIFICHE ANNULLATE - "
" PRONTE PER ESSERE CONSOLIDATE - "
CM1-DATACHIARO DELIMITED BY SIZE INTO CM1-MSG
PERFORM STAMPA THRU EX-STAMPA
MOVE SPACES TO CM1-MSG
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
* E PREPARO LA STAMPA
IF IN11 OF MC021CTL-I-INDIC = IND-ON
COMPUTE RIGA = 60
MOVE SPACES TO CM1-MSG
STRING "RETTIFICHE ANNULLATE - "
" CONSOLIDAMENTO DEL "
CM1-DATACHIARO DELIMITED BY SIZE INTO CM1-MSG
PERFORM STAMPA THRU EX-STAMPA
PERFORM CONFERMA THRU EX-CONFERMA
MOVE SPACES TO CM1-MSG
MOVE "OK! PRONTA CODA DI STAMPA SRTAN041" TO CM1-MSG
MOVE IND-ON TO IN12 OF MC021CTL-I-INDIC
GO TO EX-SCRIVI-LEGGI
END-IF.
* COL TASTO INVIO OPERO UNA SCELTA MANUALE
MOVE SPACES TO CM1-MSG
STRING "RETTIFICHE ANNULLATE - "
" CONSOLIDAMENTO DEL "
CM1-DATACHIARO DELIMITED BY SIZE INTO CM1-MSG
OPEN OUTPUT SRTAN041
MOVE 0 TO WTOTRETT WIMPRETT
MOVE 60 TO RIGA
PERFORM SCELTA THRU EX-SCELTA UNTIL F-STATUS NOT = "00".
IF WTOTRETT > 0
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
END-IF.
IF SCELTAFATTA = 9
MOVE 0 TO SCELTAFATTA
MOVE SPACES TO CM1-MSG
MOVE "OK! PRONTA CODA DI STAMPA SRTAN041" TO CM1-MSG
MOVE IND-ON TO IN12 OF MC021CTL-I-INDIC
ELSE
MOVE SPACES TO CM1-MSG
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 AND MC21SC OF MC021-I NOT = SPACES
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
PERFORM STAMPA2 THRU EX-STAMPA2
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
MOVE WMATR TO WMATR2
MOVE WPROG TO WPROG2
IF WNUMINAD = 0
EXEC SQL
UPDATE ARTDEFPRI SET RTFLSTAT = 4,
RTDTSTAT = :WDATA,
RTFLCONS = 1,
RTRIFGIOR = :W-SRMATR
WHERE RTMATAZI = :WMATR
AND RTD10PER = :WPERI3
AND RTPROPER = :WPROG
END-EXEC
ELSE
EXEC SQL
UPDATE ARTDEFPRI SET RTFLSTAT = 4,
RTDTSTAT = :WDATA,
RTFLCONS = 1
WHERE RTMATAZI = :WMATR
AND RTD10PER = :WPERI3
AND RTPROPER = :WPROG
END-EXEC
END-IF
END-IF
IF SQLCODE NOT = 0
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 "PRTAN06" TO CM1-ERRPGM
MOVE 4 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF
IF WNUMINAD = 0
EXEC SQL
INSERT INTO ARTSTORIA (STMATAZI, STD10PER, STPROPER,
STDATA, STITER, STFASE, STOPER)
VALUES(:WMATR2, :WPERI3, :WPROG2, :WDATA,
:WITSTO, 22, :WSRMATR)
END-EXEC
ELSE
EXEC SQL
INSERT INTO ARTSTORIA (STMATAZI, STD10PER, STPROPER,
STDATA, STITER, STFASE, STOPER)
VALUES(:WMATR2, :WPERI3, :WPROG2, :WDATA,
:WITSTO, 20, :W-SROLD2)
END-EXEC
END-IF
IF SQLCODE NOT = 0
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 "ARTSTORIA" TO CM1-ERRFILE
MOVE "PRTAN06" TO CM1-ERRPGM
MOVE 5 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
ELSE
EXEC SQL COMMIT END-EXEC
MOVE SPACES TO CM1-MSG
END-IF.
IF WITER = "EN"
* chiamo il Pgm Prtst21 per scrivere nel campo RTFILLER
MOVE WMATR TO CM1-MATRICOLA
MOVE WPERI3 TO CM1-D10PER
MOVE WPROG TO CM1-PROPER
CALL "PRTST21" USING AREA-MN01
CANCEL "PRTST21"
END-IF.
EX-SCELTA. EXIT.
* TASTO F5 / F11
TESTATA.
COMPUTE RIGA = 1
MOVE CM1-MSG TO 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".
FINE-TESTATA.
STAMPA.
MOVE 0 TO WTOTRETT WIMPRETT.
OPEN OUTPUT SRTAN041
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, :WNUMINAD, :W-SROLD
END-EXEC
PERFORM UNTIL SQLCODE NOT = 0
IF RIGA > 56
PERFORM TESTATA THRU FINE-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, :WNUMINAD, :W-SROLD
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.
STAMPA2.
IF RIGA > 56
COMPUTE RIGA = 1
MOVE CM1-MSG TO 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.
MOVE WMATR TO SMATR.
MOVE WTIP TO STIPO.
MOVE WITER2 TO SITER.
STRING WPERI(1:2) "/" WPERI(3:4) DELIMITED BY SIZE
INTO SPERI.
MOVE WCALC TO SSANZ.
MOVE WDEN TO SDIFF.
MOVE WDIFF TO SSALDO.
ADD WDIFF TO WIMPRETT.
ADD 1 TO WTOTRETT RIGA.
WRITE REC-STAMPA FROM CORPO-O
FORMAT IS "CORPO".
EX-STAMPA2. EXIT.
* TASTO F11
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, :WNUMINAD, :W-SROLD
END-EXEC
PERFORM UNTIL SQLCODE NOT = 0
IF WNUMINAD = 0
EXEC SQL
UPDATE ARTDEFPRI SET RTFLSTAT = 4,
RTDTSTAT = :WDATA,
RTFLCONS = 1,
RTRIFGIOR = :W-SRMATR
WHERE RTMATAZI = :CM2-MATRICOLA
AND RTD10PER = :CM2-D10PER
AND RTPROPER = :CM2-PROPER
END-EXEC
ELSE
EXEC SQL
UPDATE ARTDEFPRI SET RTFLSTAT = 4,
RTDTSTAT = :WDATA,
RTFLCONS = 1
WHERE RTMATAZI = :CM2-MATRICOLA
AND RTD10PER = :CM2-D10PER
AND RTPROPER = :CM2-PROPER
END-EXEC
END-IF
IF SQLCODE NOT = 0
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 "PRTAN06" TO CM1-ERRPGM
MOVE 6 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF
IF WNUMINAD = 0
EXEC SQL
INSERT INTO ARTSTORIA (STMATAZI, STD10PER, STPROPER,
STDATA, STITER, STFASE, STOPER)
VALUES(:CM2-MATRICOLA, :CM2-D10PER, :CM2-PROPER,
:WDATA, :WITSTO, 22, :WSRMATR)
END-EXEC
ELSE
EXEC SQL
INSERT INTO ARTSTORIA (STMATAZI, STD10PER, STPROPER,
STDATA, STITER, STFASE, STOPER)
VALUES(:CM2-MATRICOLA, :CM2-D10PER, :CM2-PROPER,
:WDATA, :WITSTO, 20, :W-SROLD2)
END-EXEC
END-IF
IF SQLCODE NOT = 0
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
EXEC SQL ROLLBACK END-EXEC
STRING "ERR.SQL(" SQLERR ")"
DELIMITED BY SIZE INTO CM1-MSG
MOVE "ARTSTORIA" TO CM1-ERRFILE
MOVE "PRTAN06" TO CM1-ERRPGM
MOVE 7 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF
EXEC SQL COMMIT HOLD END-EXEC
IF WITER = "EN"
* chiamo il Pgm Prtst21 per scrivere nel campo RTFILLER
MOVE CM2-MATRICOLA TO CM1-MATRICOLA
MOVE CM2-D10PER TO CM1-D10PER
MOVE CM2-PROPER TO CM1-PROPER
CALL "PRTST21" USING AREA-MN01
CANCEL "PRTST21"
END-IF
EXEC SQL
FETCH C1 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR, :WNUMINAD, :W-SROLD
END-EXEC
END-PERFORM.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
EXEC SQL ROLLBACK END-EXEC
STRING "ERR.SQL(" SQLERR ")"
DELIMITED BY SIZE INTO CM1-MSG
MOVE "ARTDEFPRI" TO CM1-ERRFILE
MOVE "PRTAN06" TO CM1-ERRPGM
MOVE 8 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
EXEC SQL CLOSE C1 END-EXEC.
EX-CONFERMA. EXIT.
