- Dettagli
- Visite: 884
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAN091.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : ANNULLAMENTO CON CODICE *
* PGM CHIAMANTI : PRTAN08 *
* PGM CHIAMATI : PRTUT02 PRTDY02 *
* MAPPE : MRTAN091 *
* AREA DI INPUT : CRTMN01 - *
* *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MRTAN09 ASSIGN TO WORKSTATION-MRTAN09
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 MRTAN09
LABEL RECORD IS omitted.
01 REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAN09.
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 FISSO1 PIC X.
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAN09.
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 MIA-AREA.
03 WEMIDA PIC S9(8).
03 WEMIAL PIC S9(8).
03 WCSC PIC S9(5).
03 WCA PIC XX.
03 WITER PIC XX.
03 WCOD PIC S9(3).
03 WMATRICOLA PIC S9(10).
03 WPERI PIC S9(6).
03 WPROGR PIC S9(2).
03 WTOT PIC 9(4).
03 WITERDA PIC S9(8).
03 WITERA PIC S9(8).
03 WSANZIX PIC X.
03 WQUAD2 PIC X.
03 STRINGA PIC X(1600).
03 WIMPRETT PIC S9(11)V9(2).
03 WTOTRETT PIC S9(11).
03 WNUMTOT PIC Z(6).
03 POSTO PIC 9(4).
03 CM2-MATRICOLA PIC S9(10).
03 CM2-D10PER PIC S9(6).
03 CM2-PROPER PIC S9(2).
03 WRETTA PIC S9.
03 WRETTP PIC S9.
03 WFLAGVAR PIC S9.
03 WSALCA PIC S9(11)V9(2).
03 WSALDO1 PIC S9(11)V9(2).
03 WSANZI PIC S9(11)V9(2).
03 WIMPRE PIC S9(11)V9(2).
03 WSACIV PIC S9(11)V9(2).
01 WFINE PIC 9.
01 WSUBAREA.
03 WSCELTA PIC X.
03 WMATR PIC 9(10).
03 WPERI1.
05 MM PIC S99.
05 AA PIC S9(4).
03 WPROG PIC 99.
01 WPERI2.
05 AA PIC S9(4).
05 MM PIC S99.
01 RIGA PIC 99.
01 WMSG PIC X(74).
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01.
MAIN.
MOVE SPACES TO CM1-MSG.
MOVE 0 TO CONTSUBF.
MOVE '"' TO FISSO1.
MOVE CM1-MATRICOLA TO CM2-MATRICOLA WMATRICOLA.
MOVE CM1-D10PER TO CM2-D10PER WPERI.
OPEN I-O MRTAN09.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAN09" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
MOVE SPACES TO CM1-MSG.
PERFORM PASSA-DATI THRU EX-PASSA-DATI.
FINE.
CLOSE MRTAN09.
GOBACK.
PASSA-DATI.
MOVE SPACES TO STRINGA.
COMPUTE POSTO = 1.
STRING "SELECT RTMATAZI, RTD10PER, RTPROPER, RTRETTA, "
"RTRETTP, RTITER, RTSALCA, RTSALDO1, "
"RTSANZI, RTIMPRE, RTFLAGVAR, RTSACIV FROM ARTDEFPRI"
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
STRING " WHERE RTCODDEF = 0 AND RTFLSTAT = 0"
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
STRING " AND RTFLABB = 0 AND RTELABCAL = 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
STRING " AND RTMATAZI = " WMATRICOLA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
IF WPERI > 0
STRING " AND RTD10PER = " WPERI
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
* DISPLAY STRINGA(1:500)
EXEC SQL
PREPARE S3 FROM :STRINGA
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.2 PGM PRTAN09"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF
EXEC SQL
DECLARE C3 CURSOR FOR S3
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 3 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.3 PGM PRTAN09"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF
EXEC SQL
OPEN C3
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 4 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.4 PGM PRTAN09"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL
FETCH C3 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR, :WSACIV
END-EXEC
IF SQLCODE = 0
PERFORM SCRIVI-MAPPA THRU EX-SCRIVI-MAPPA
ELSE
MOVE "RETTIFICA NON DISPONIBILE" TO CM1-MSG
END-IF
END-PERFORM.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 5 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.5 PGM PRTAN09"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF
EXEC SQL
CLOSE C3
END-EXEC.
IF CONTSUBF > 0
MOVE SPACES TO MC02MSG OF MC021CODA-O CM1-MSG
MOVE "Scegli la Rettifica da Annullare e Premi INVIO"
TO MC02MSG OF MC021CODA-O WMSG
MOVE 1 TO CONTSUBF
MOVE IND-OFF TO IN12 OF MC021CTL-I-INDIC
PERFORM SCRIVI-LEGGI THRU EX-SCRIVI-LEGGI
UNTIL IN12 OF MC021CTL-I-INDIC = IND-ON
* ELSE
* MOVE "NESSUNA RETTIFICA SELEZIONATA" TO CM1-MSG
END-IF.
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 SPACES TO MC021SCEL OF MC021-I
WRITE SUBFILE REC-VIDEO FORMAT "MC021"
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAN09" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 6 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-SCRIVI-MAPPA. EXIT.
SCRIVI-LEGGI.
WRITE REC-VIDEO FORMAT "MC021CODA".
MOVE CM1-DATACHIARO TO MC021OGGI.
WRITE REC-VIDEO FORMAT "MC021CTL"
READ MRTAN09 FORMAT "MC021CTL"
INDICATORS ARE MC021CTL-I-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAN09" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 7 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
* COL TASTO F2 VEDO IL DETTAGLIO DELLA RETTIFICA
IF IN02 OF MC021CTL-I-INDIC = IND-ON
MOVE IND-OFF TO IN02 OF MC021CTL-I-INDIC
PERFORM DETTAGLIO THRU EX-DETTAGLIO
MOVE WMSG TO MC02MSG OF MC021CODA-O
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.
MOVE 0 TO WTOT.
PERFORM CONTA THRU EX-CONTA UNTIL F-STATUS NOT = "00".
MOVE 0 TO CONTSUBF.
IF WTOT > 1
MOVE SPACES TO MC02MSG OF MC021CODA-O
MOVE " Puoi scegliere solo una Rettifica"
TO CM1-MSG
END-IF.
IF WTOT = 1
PERFORM SCELTI THRU EX-SCELTI
END-IF.
MOVE IND-ON TO IN12 OF MC021CTL-I-INDIC.
EX-SCRIVI-LEGGI.
EXIT.
CONTA.
READ SUBFILE MRTAN09 MODIFIED INTO WSUBAREA FORMAT "MC021"
AT END
MOVE 0 TO WFINE
NOT AT END
MOVE 1 TO WFINE.
IF WFINE = 1
ADD 1 TO WTOT
END-IF.
EX-CONTA.
SCELTI.
ADD 1 TO CONTSUBF
READ SUBFILE MRTAN09 MODIFIED INTO WSUBAREA FORMAT "MC021".
IF MC021SCEL OF MC021-I NOT = SPACE
MOVE SPACES TO MC021SCEL OF MC021-I
REWRITE SUBFILE REC-VIDEO FORMAT IS "MC021"
MOVE WMATR TO CM1-MATRICOLA
MOVE CORRESPONDING WPERI1 TO WPERI2
MOVE WPERI2 TO CM1-D10PER
MOVE WPROG TO CM1-PROPER
MOVE WTOT TO CM1-SC7
CALL "PRTAN10" USING AREA-MN01
END-IF.
EX-SCELTI. EXIT.
DETTAGLIO.
READ SUBFILE MRTAN09 MODIFIED INTO WSUBAREA FORMAT "MC021"
AT END
MOVE 0 TO WFINE
NOT AT END
MOVE 1 TO WFINE.
IF WFINE = 1
MOVE SPACES TO MC021SCEL OF MC021-I
REWRITE SUBFILE REC-VIDEO FORMAT IS "MC021"
MOVE WMATR TO CM1-MATRICOLA
MOVE CORRESPONDING WPERI1 TO WPERI2
MOVE WPERI2 TO CM1-D10PER
MOVE WPROG TO CM1-PROPER
CALL "PRTDY02" USING AREA-MN01
END-IF.
EX-DETTAGLIO. EXIT.
STAMPA.
EXEC SQL
OPEN C3
END-EXEC
MOVE 0 TO WTOTRETT WIMPRETT.
OPEN OUTPUT SRTAN041
EXEC SQL
FETCH C3 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR, :WSACIV
END-EXEC
PERFORM UNTIL SQLCODE NOT = 0
IF RIGA > 56
MOVE 1 TO RIGA
STRING "RETTIFICHE SELEZIONATE "
"IN DATA " CM1-DATACHIARO DELIMITED BY SIZE INTO SMSG
MOVE CM1-DENOM-SEDE TO SSEDE
STRING "GRUPPO DI PROCESSO N. " CM1-GRUPPO
DELIMITED BY SIZE INTO SGRUPPO
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 C3 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-PROPER,
:WRETTA, :WRETTP, :WITER, :WSALCA, :WSALDO1,
:WSANZI, :WIMPRE, :WFLAGVAR, :WSACIV
END-EXEC
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAN09" TO CM1-ERRPGM
MOVE 10 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.10 PGM PRTAN09"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF
END-PERFORM.
EXEC SQL
CLOSE C3
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.
