- Dettagli
- Visite: 1316
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAN071.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : CONSULTAZIONE RETTIFICHE FLAGGATE PER ANNULL.*
* 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 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 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 "PRTAN07" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
PERFORM SEQUENZA THRU EX-SEQUENZA.
FINE.
CLOSE MRTAN04.
GOBACK.
SEQUENZA.
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 CM1-MSG
STRING "RETTIFICHE SELEZIONATE N° " WNUM DELIMITED
BY SIZE INTO MC02MSG OF MC021CODA-O
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 POSTO = 1.
STRING "SELECT RTMATAZI, RTD10PER, RTPROPER, RTRETTA, "
"RTRETTP, RTITER, RTSALCA, RTSALDO1, RTSANZI, "
" RTIMPRE, RTFLAGVAR FROM ARTDEFPRI "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " WHERE 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.
* DISPLAY STRINGA
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 PRTAN07"
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 PRTAN07"
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 PRTAN07"
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 PRTAN07"
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
* MOVE IND-ON TO IN73.
WRITE SUBFILE REC-VIDEO FORMAT "MC021"
INDICATORS ARE MC021-O-INDIC
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAN04" TO CM1-ERRFILE
MOVE "PRTAN07" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-SCRIVI-MAPPA. EXIT.
SCRIVI-LEGGI.
MOVE IND-ON TO IN74.
MOVE IND-OFF TO IN12 OF MC021CTL-I-INDIC
MOVE IND-OFF TO IN05 OF MC021CTL-I-INDIC
WRITE REC-VIDEO FORMAT "MC021CODA"
INDICATORS ARE MC021CODA-O-INDIC.
MOVE CM1-DATACHIARO TO MC021OGGI.
MOVE " RETTIFICHE SELEZIONATE PER ANNULLAMENTO" TO MTIT2
WRITE REC-VIDEO FORMAT "MC021CTL"
INDICATORS ARE MC021-O-INDIC.
READ MRTAN04 FORMAT "MC021CTL"
INDICATORS ARE MC021CTL-I-INDIC.
MOVE SPACES TO MC02MSG OF MC021CODA-O
STRING "RETT. SELEZIONATE N° " WNUM
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 "PRTAN07" TO CM1-ERRPGM
MOVE 3 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
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
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
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.
MOVE IND-ON TO IN12 OF MC021CTL-I-INDIC.
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.
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
PERFORM UNTIL SQLCODE NOT = 0
IF RIGA > 56
COMPUTE RIGA = 1
STRING "RETTIFICHE SELEZIONATE PER ANNULLAMENTO - "
" " 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
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.
