- Dettagli
- Visite: 958
*$ COMMIT *CHG
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ071.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : VARIAZIONE DATI PAGAMENTO DEI DOCUMENTI DIVER.*
* Se la matricola variata è presente in Lazie009 e se il codice*
* fiscale presente in Artdeu è uguale a quello di Lazie009 *
* accetto la modifica alla matricola e al periodo *
* e registro la variazione in Artdeu *
* VARIAZ.MATRICOLA CONSENTITA SOLO PER I PAGAMENTI TELEMATICI *
* PGM CHIAMANTI : PRTAQ06 *
* PGM CHIAMATI : PRTUT02 *
* MAPPE : MRTAQ05 *
* AREA DI INPUT : CRTMN01 - *
* ARCHIVI : ARTDEU *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
SOURCE-COMPUTER. AS400.
OBJECT-COMPUTER. AS400.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VIDEO ASSIGN TO WORKSTATION-MRTAQ05
ORGANIZATION IS TRANSACTION
ACCESS IS SEQUENTIAL
FILE STATUS IS F-STATUS.
I-O-CONTROL.
COMMITMENT CONTROL FOR ARTDEU LAZIE009.
DATA DIVISION.
FILE SECTION.
FD VIDEO
LABEL RECORD IS OMITTED.
01 REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAQ05.
WORKING-STORAGE SECTION.
EXEC SQL
INCLUDE SQLCA
END-EXEC.
01 F-STATUS PIC XX.
01 IND-ON PIC 1 VALUE B"1".
01 IND-OFF PIC 1 VALUE B"0".
01 SQLERR PIC 9(5).
01 WFINE PIC 9.
*01 WMATROLD PIC S9(10).
01 WMATROLD PIC X(10).
BPOLD2*01 WIMPORPAG PIC S9(15).
BPNEW2 01 WIMPORPAG PIC S9(13)V9(002).
BPINFO* CVG1110 Field WIMPORPAG contains class AMOUNT.
01 WDATARISC PIC S9(8).
01 WCODICFIS PIC X(16).
01 WTIREC PIC S9.
01 WCODIENTE PIC S9(5).
01 WCODCAB PIC X(5).
01 WMATAZI PIC X(10).
01 WMATAZIOLD PIC X(10).
01 WPER PIC S9(6).
01 WWPER REDEFINES WPER.
03 WAA PIC 9(4).
03 WMM PIC 99.
01 WMATAZI2 PIC X(10).
01 WPEROLD PIC S9(6).
01 WPER2 PIC S9(6).
01 WMATRLAZ.
03 WLAZPRO PIC S9(2).
03 WLAZMAT PIC S9(6).
03 WLAZCTR PIC S9(2).
01 WCODFLAZ PIC X(16).
01 WCM1-SC7 PIC S9(12).
01 WCM1-PROG PIC S9(4).
01 SUADATA.
03 AAAA PIC 9(4).
03 MM PIC 99.
03 GG PIC 99.
01 MIADATA.
03 GG PIC 99.
03 FILLER PIC X VALUE "/".
03 MM PIC 99.
03 FILLER PIC X VALUE "/".
03 AAAA PIC 9(4).
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ05.
****************************************************************
* AREA DI COLLOQUIO COL PGM CHIAMANTE *
****************************************************************
LINKAGE SECTION.
BPINFO* CVR2019 Found explicit reference to library or file DCBCPY;
BPINFO* manual handling may be required
BPCHCK COPY CRTMN01 OF DCBCPY.
*****************************************************************
* P R O C E D U R E D I V I S I O N *
*****************************************************************
BPEURO PROCEDURE DIVISION USING AREA-MN01.
BPINFO* CVG1011 In field AREA-MN01 found the following classes:
BPINFO* CVG1010 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field CM1-IMPA contains class AMOUNT.
MAIN.
MOVE 0 TO WFINE WPER.
MOVE CM1-SC7 TO WCM1-SC7.
MOVE CM1-PROG TO WCM1-PROG.
PERFORM APRI THRU EX-APRI.
MOVE SPACES TO MQ7MSG.
EXEC SQL
BPEURO SELECT RDEUMATOLD, AIMPORPAG, ADATARISC, ACODICFIS,
RDEUTIREC, ACODIENTE, ACODICCAB, RDEUMATAZI,
RDEUPERCED
BPEURO INTO :WMATROLD, :WIMPORPAG, :WDATARISC,
:WCODICFIS, :WTIREC, :WCODIENTE, :WCODCAB,
:WMATAZI, :WPER
FROM ARTDEU
WHERE RDEUSC724 = :WCM1-SC7
AND RDEUPROGR = :WCM1-PROG
END-EXEC.
BPINFO* CVG1110 Field WIMPORPAG contains class AMOUNT.
MOVE WPER TO WPEROLD.
MOVE WMATAZI TO WMATAZIOLD.
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL WFINE = 1.
FINE.
CLOSE VIDEO.
GOBACK.
APRI.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ05" TO CM1-ERRFILE
MOVE "PRTAQ07" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
BPINFO* CVG1011 In field AREA-MN01 found the following classes:
BPINFO* CVG1010 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field CM1-IMPA contains class AMOUNT.
END-IF.
BPDSPF WRITE REC-VIDEO FORMAT "MQ08".
BPINFO* CVG1011 In field REC-VIDEO found the following classes:
BPINFO* CVG1010 Field MQ5IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field MQ5IMPA contains class AMOUNT.
EX-APRI.
EXIT.
SEQUENZA.
MOVE IND-OFF TO IN12 OF MQ07-I-INDIC.
MOVE WMATROLD TO MQ7OLD.
BPDSPF MOVE WIMPORPAG TO MQ7VERS.
BPINFO* CVG1118 Fields WIMPORPAG and MQ7VERS contain the following
BPINFO* class AMOUNT
MOVE WDATARISC TO SUADATA.
MOVE CORRESPONDING SUADATA TO MIADATA.
MOVE MIADATA TO MQ7DATA.
MOVE CM1-SC7 TO MQ7SC7.
MOVE WCODICFIS TO MQ7FISC.
MOVE WCODIENTE TO MQ7ENTE.
MOVE WCODCAB TO MQ7CAB.
MOVE WMM TO MQ7MESE OF MQ07-O.
MOVE WAA TO MQ7ANNO OF MQ07-O.
MOVE WMATAZI TO MQ7NEW OF MQ07-O.
IF WTIREC = 0
MOVE "F24" TO MQ7PROV
END-IF.
IF WTIREC = 3
MOVE "Acquisiz.interattiva" TO MQ7PROV
END-IF.
IF WTIREC = 1
MOVE "Acquisiz.Doc.Diversi" TO MQ7PROV
END-IF.
IF WTIREC = 2
MOVE "TEF" TO MQ7PROV
END-IF.
BPDSPF WRITE REC-VIDEO FORMAT "MQ07".
BPINFO* CVG1011 In field REC-VIDEO found the following classes:
BPINFO* CVG1010 Field MQ5IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field MQ5IMPA contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ05" TO CM1-ERRFILE
MOVE "PRTAQ07" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
BPINFO* CVG1011 In field AREA-MN01 found the following classes:
BPINFO* CVG1010 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field CM1-IMPA contains class AMOUNT.
END-IF.
BPDSPF READ VIDEO FORMAT "MQ07"
INDICATORS ARE MQ07-I-INDIC.
BPINFO* CVG1011 In field VIDEO found the following classes:
BPINFO* CVG1010 Field MQ5IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field MQ5IMPA contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ05" TO CM1-ERRFILE
MOVE "PRTAQ07" TO CM1-ERRPGM
MOVE 3 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
BPINFO* CVG1011 In field AREA-MN01 found the following classes:
BPINFO* CVG1010 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field CM1-IMPA contains class AMOUNT.
END-IF.
IF IN12 OF MQ07-I-INDIC = IND-ON
MOVE 1 TO WFINE
GO TO EX-SEQUENZA
END-IF.
IF MQ7MESE OF MQ07-I IS = 0 OR MQ7MESE OF MQ07-I IS > 12
MOVE "MESE DEL PERIODO NON VALIDO" TO MQ7MSG
GO TO EX-SEQUENZA
END-IF.
IF MQ7ANNO OF MQ07-I IS < 1980
MOVE "ANNO DEL PERIODO NON VALIDO" TO MQ7MSG
GO TO EX-SEQUENZA
END-IF.
MOVE MQ7NEW OF MQ07-I TO WMATAZI2 WMATRLAZ.
MOVE MQ7ANNO OF MQ07-I TO WAA.
MOVE MQ7MESE OF MQ07-I TO WMM.
MOVE WPER TO WPER2.
IF WMATAZI2 IS = WMATAZIOLD AND WPER2 IS = WPEROLD
MOVE "DATI NON VARIATI" TO MQ7MSG
GO TO EX-SEQUENZA
END-IF.
IF WMATAZI2 IS NOT = WMATAZIOLD
AND (WTIREC = 1 OR WTIREC = 3)
MOVE "VAR.MATRICOLA NON CONSENTITA" TO MQ7MSG
GO TO EX-SEQUENZA
END-IF.
IF WMATAZI2 IS NOT = WMATAZIOLD
PERFORM CONTROLLO THRU EX-CONTROLLO
IF WMATAZI2 IS NOT = WMATAZIOLD AND
((WCODFLAZ NOT = WCODICFIS) OR (WCODFLAZ = SPACES))
MOVE "VARIAZIONE NON CONSENTITA!" TO MQ7MSG
GO TO EX-SEQUENZA
END-IF
END-IF.
IF IN11 OF MQ07-I-INDIC = IND-ON
EXEC SQL
UPDATE ARTDEU SET RDEUMATAZI = :WMATAZI2,
RDEUPERCED = :WPER2,
RDEUFLABB = 0
WHERE RDEUSC724 = :WCM1-SC7
AND RDEUPROGR = :WCM1-PROG
END-EXEC
IF SQLCODE = 0
EXEC SQL COMMIT END-EXEC
MOVE "PAGAMENTO VARIATO CON SUCCESSO" TO MQ7MSG
ELSE
EXEC SQL ROLLBACK END-EXEC
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.4 PGM PRTAQ07"
DELIMITED BY SIZE INTO MQ7MSG
END-IF
ELSE
MOVE "PREMI F11 PER CONFERMA VARIAZIONI!" TO MQ7MSG
END-IF.
EX-SEQUENZA.
EXIT.
* Se la matricola variata è presente in Lazie009 e se il codice
* fiscale presente in Artdeu è uguale a quello di Lazie009
* accetto la modifica alla matricola e al periodo
* e registro la variazione in Artdeu
CONTROLLO.
MOVE SPACES TO WCODFLAZ.
EXEC SQL
SELECT AZCODFIS
INTO :WCODFLAZ
FROM LAZIE009
WHERE AZCODPRO = :WLAZPRO
AND AZMATAZI = :WLAZMAT
AND AZCTRCOD = :WLAZCTR
END-EXEC.
EX-CONTROLLO.
EXIT.
