- Dettagli
- Visite: 1058
*$ COMMIT *CHG
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ091.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : ACQUISIZIONE INTERATTIVA PAGAMENTI *
* PGM CHIAMANTI : PRTMN01 *
* PGM CHIAMATI : *
* MAPPE : MRTAQ01 *
* AREA DI INPUT : *
* ARCHIVI : ARTDEU *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA
REQUESTOR IS WORK-STATION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VIDEO ASSIGN TO WORKSTATION-MRTAQ01-SI
ORGANIZATION IS TRANSACTION
ACCESS IS SEQUENTIAL
FILE STATUS IS F-STATUS.
SELECT ARTDEU ASSIGN TO DATABASE-ARTDEU
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
FILE STATUS IS F-STATUS.
SELECT DS79 ASSIGN TO DATABASE-ASCO0079
ORGANIZATION IS INDEXED
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
ACCESS IS DYNAMIC
FILE STATUS IS F-STATUS.
I-O-CONTROL.
COMMITMENT CONTROL FOR ARTDEU ASCO0079.
DATA DIVISION.
FILE SECTION.
FD VIDEO
LABEL RECORD IS OMITTED.
01 REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAQ01.
FD ARTDEU
LABEL RECORD IS OMITTED.
01 REC-ARTDEU.
COPY DDS-ALL-FORMAT OF ARTDEU.
FD DS79.
01 DS79-REC.
COPY DDS-ALL-FORMATS OF ASCO0079.
WORKING-STORAGE SECTION.
*********************************************
EXEC SQL
INCLUDE SQLCA
END-EXEC.
01 SQLERR PIC 9(5).
01 F-STATUS PIC XX.
01 IND-ON PIC 1 VALUE B"1".
01 IND-OFF PIC 1 VALUE B"0".
01 WUTIL PIC S9.
01 WPROGR PIC S9(4) VALUE 0.
01 WFINE PIC 9.
01 WC0ANNU PIC S9(4).
01 PERI.
03 ANNOPERI PIC 9(4).
03 MESEPERI PIC 99.
01 WMATAZI PIC X(10).
01 WWMATAZI REDEFINES WMATAZI.
03 WWCODPRO PIC S99.
03 WWMATAZI PIC S9(6).
03 WWCTRCOD PIC S99.
01 WPERI PIC S9(6).
01 SUADATA.
03 ANNO PIC 9(4).
03 MESE PIC 99.
03 GIORNO PIC 99.
01 WSTSC PIC S9(1).
01 WSC724 PIC S9(12).
01 CHIAVE-ASCO.
03 WTIP PIC X.
03 WART PIC S9(6).
03 WNUM PIC S9(5).
BPOLD2*01 IMPASCO PIC S9(13).
BPNEW2 01 IMPASCO PIC S9(11)V9(002).
BPINFO* CVG1110 Field IMPASCO contains class AMOUNT.
01 WC0NR10 PIC S9(5).
01 WC0NRESA PIC S9(5).
BPOLD2*01 WC0IMESA PIC S9(13).
BPNEW2 01 WC0IMESA PIC S9(11)V9(002).
BPINFO* CVG1110 Field WC0IMESA contains class AMOUNT.
01 WSOMMA PIC S9(13).
BPOLD2*01 WIMPPA PIC S9(13).
BPNEW2 01 WIMPPA PIC S9(11)V9(002).
BPINFO* CVG1110 Field WIMPPA contains class AMOUNT.
01 ESISTE PIC S9.
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ01.
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.
MAIN.
MOVE 0 TO WPROGR WSTSC WMATAZI WPERI WFINE.
MOVE 9 TO WUTIL.
PERFORM APRI THRU EX-APRI.
MOVE IND-OFF TO IN12 OF MA06-I-INDIC.
MOVE 0 TO MA6SC7 OF MA06-I.
PERFORM CONTROLLO THRU EX-CONTROLLO
UNTIL IN12 OF MA06-I-INDIC = IND-ON.
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL IN12 OF MA05-I-INDIC = IND-ON.
FINE.
ROLLBACK.
CLOSE VIDEO ARTDEU DS79.
GOBACK.
APRI.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
OPEN I-O ARTDEU.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
OPEN I-O DS79.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 3 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-APRI.
EXIT.
CONTROLLO.
BPDSPF WRITE REC-VIDEO FORMAT "MA06".
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 4 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
BPDSPF READ VIDEO FORMAT "MA06"
INDICATORS ARE AREA-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 5 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
IF IN12 OF MA06-I-INDIC = IND-ON OR MA6SC7 OF MA06-I = 0
GO TO FINE
END-IF.
MOVE MA6SC7 OF MA06-I TO CHIAVE-ASCO WSC724.
* CONSERVO IN IMPASCO L'IMPORTO DELL'SC7/24 LETTO NEL DS079
MOVE WTIP TO AC0K1TIP
MOVE WART TO AC0K1ART
MOVE WNUM TO AC0K1NUM
READ DS79.
IF F-STATUS NOT EQUAL "00"
IF F-STATUS NOT = "10" AND F-STATUS NOT = "23"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 7 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
MOVE "SC7/24 NON PRESENTE" TO MA6MSG OF MA06-O
GO TO EX-CONTROLLO
END-IF.
IF AC0SITSC = 2
MOVE "SC7/24 GIA' CONSOLIDATO" TO MA6MSG OF MA06-O
GO TO EX-CONTROLLO
END-IF.
BPEURO MOVE AC0IMCOR TO IMPASCO.
MOVE AC0NR10 TO WC0NR10.
MOVE AC0NRESA TO WC0NRESA.
BPEURO MOVE AC0IMESA TO WC0IMESA.
MOVE AC0ANNU TO WC0ANNU.
IF WC0ANNU < 1900
IF WC0ANNU > 88
ADD 1900 TO WC0ANNU
ELSE
ADD 2000 TO WC0ANNU
END-IF
END-IF.
* METTO A 1 IL CAMPO AC0SITSC PER PRESA IN CARICO
IF AC0SITSC = 0
MOVE 1 TO AC0SITSC
BPEURO REWRITE DS79-REC
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 8 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
COMMIT
END-IF.
EXEC SQL
SELECT MAX(RDEUPROGR) INTO :WPROGR FROM ARTDEU
WHERE RDEUSC724 = :WSC724
AND RDEUFLUTIL = 3
AND RDEUTIREC = 3
END-EXEC.
IF SQLCODE NOT = 0
MOVE 0 TO WPROGR
END-IF.
MOVE IND-ON TO IN12 OF MA06-I-INDIC.
EX-CONTROLLO.
EXIT.
SEQUENZA.
BPEURO CALL "PRTUT01" USING AREA-MN01.
MOVE WSC724 TO MA5SC7 OF MA05-O.
MOVE 0 TO MA5MATR OF MA05-O MA5MESEPA OF MA05-O
BPDSPF MA5ANNOPA OF MA05-O MA5IMPPA OF MA05-O
MA5MEPER OF MA05-O MA5ANPER OF MA05-O
MA5GIORPA OF MA05-O
BPDSPF WRITE REC-VIDEO FORMAT "MA05".
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 9 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
BPDSPF READ VIDEO FORMAT "MA05"
INDICATORS ARE AREA-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 10 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
IF IN12 OF MA05-I-INDIC = IND-ON
MOVE SPACES TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
IF MA5ANNOPA OF MA05-I IS NOT NUMERIC
OR MA5MATR OF MA05-I IS NOT NUMERIC
OR MA5MESEPA OF MA05-I IS NOT NUMERIC
OR MA5GIORPA OF MA05-I IS NOT NUMERIC
BPDSPF OR MA5IMPPA OF MA05-I IS NOT NUMERIC
OR MA5SC7 OF MA05-I IS NOT NUMERIC
MOVE "Acquisizione fallita perchè incompleta" TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
IF MA5ANNOPA OF MA05-I IS = 0
OR MA5MATR OF MA05-I IS = 0
OR MA5MESEPA OF MA05-I IS = 0
OR MA5GIORPA OF MA05-I IS = 0
BPDSPF OR MA5IMPPA OF MA05-I IS = 0
OR MA5SC7 OF MA05-I IS = 0
MOVE "Acquisizione fallita perchè incompleta" TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
IF WFINE = 9
MOVE "Acquisizione completata" TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
MOVE MA5MATR OF MA05-I TO WMATAZI.
MOVE 0 TO ESISTE
EXEC SQL
SELECT COUNT(*) INTO :ESISTE FROM LAZIE009
WHERE AZCODPRO = :WWCODPRO
AND AZMATAZI = :WWMATAZI
AND AZCTRCOD = :WWCTRCOD
END-EXEC.
IF ESISTE = 0
MOVE "Matricola non presente in archivio" TO CM1-MSG
GO TO EX-SEQUENZA
END-IF
MOVE SPACES TO CM1-MSG.
INITIALIZE RECDEU.
MOVE 3 TO RDEUTIREC.
MOVE 3 TO RDEUFLUTIL.
MOVE 0 TO RDEUIMPUT.
MOVE "DMRAA" TO ACTRIBUT.
MOVE WSC724 TO RDEUSC724.
MOVE MA5MATR OF MA05-I TO RDEUMATAZI.
BPDSPF MOVE MA5IMPPA OF MA05-I TO AIMPORPAG WIMPPA.
MOVE MA5ANNOPA OF MA05-I TO ANNO.
MOVE MA5MESEPA OF MA05-I TO MESE.
MOVE MA5GIORPA OF MA05-I TO GIORNO.
MOVE SUADATA TO ADATARISC.
MOVE MA5ANPER OF MA05-I TO ANNOPERI.
MOVE MA5MEPER OF MA05-I TO MESEPERI.
MOVE PERI TO RDEUPERCED WPERI.
MOVE CM1-DATAG TO RDEUDTCAR.
MOVE 0 TO RDEUIMPDIS.
ADD 1 TO WPROGR.
MOVE WPROGR TO RDEUPROGR.
BPEURO WRITE REC-ARTDEU.
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 13 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
* Aggiorno il record su ASCO0079 con i dati della cedola
COMPUTE WC0NRESA = WC0NRESA + 1
BPSCCL COMPUTE WC0IMESA = WC0IMESA + WIMPPA
MOVE WC0NRESA TO AC0NRESA
BPEURO MOVE WC0IMESA TO AC0IMESA
BPEURO REWRITE DS79-REC
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 14 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
IF F-STATUS = "00"
COMMIT
ELSE
ROLLBACK
END-IF.
PERFORM CONTROLLO2 THRU EX-CONTROLLO2.
EX-SEQUENZA.
EXIT.
CONTROLLO2.
BPEURO IF AC0IMESA = IMPASCO
MOVE "SC7/24 QUADRATO REGOLARMENTE" TO MA5MSG OF MA05-O
MOVE 9 TO WFINE
EXEC SQL
UPDATE ARTDEU SET RDEUIMPDIS = AIMPORPAG,
RDEUANCO = :WC0ANNU,
RDEUFLUTIL = 0
WHERE RDEUSC724 = :WSC724
END-EXEC
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.15 PGM PRTAQ09"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF
MOVE 2 TO AC0SITSC
BPEURO REWRITE DS79-REC
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ09" TO CM1-ERRPGM
MOVE 15 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
COMMIT
END-IF.
BPEURO IF AC0IMESA > IMPASCO
MOVE "SC7/24 SQUADRATO!!" TO MA5MSG OF MA05-O
* MOVE 9 TO WFINE
END-IF.
EX-CONTROLLO2.
EXIT.