- Dettagli
- Visite: 802
*$ COMMIT *CHG
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ101.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : VARIAZIONE PAGAMENTI NON TELEMATICI *
* PGM CHIAMANTI : PRTMN01 *
* PGM CHIAMATI : *
* MAPPE : MRTAQ101 *
* 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-MRTAQ10
ORGANIZATION IS TRANSACTION
ACCESS IS SEQUENTIAL
FILE STATUS IS F-STATUS.
SELECT VIDEO2 ASSIGN TO WORKSTATION-MRTAQ11
ORGANIZATION IS TRANSACTION
ACCESS IS DYNAMIC
RELATIVE KEY IS CONTSUBF
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 DS79.
DATA DIVISION.
FILE SECTION.
FD VIDEO
LABEL RECORD IS OMITTED.
01 REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAQ10.
FD VIDEO2
LABEL RECORD IS OMITTED.
01 REC-VIDEO2.
COPY DDS-ALL-FORMAT OF MRTAQ11.
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 MODIFICATO PIC 9.
01 FINITO PIC 9.
01 W-RINPROGR PIC S9(4) VALUE 0.
01 WFINE PIC 9.
01 WQUANTI PIC 9(4).
01 CONTSUBF PIC 9(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 SUOPERI.
03 ANNO PIC 9(4).
03 MESE PIC 99.
01 MIOPERI.
03 MESE PIC 99.
03 FILLER PIC X VALUE "/".
03 ANNO PIC 9(4).
01 SUADATA.
03 ANNO PIC 9(4).
03 MESE PIC 99.
03 GIORNO PIC 99.
01 MIADATA.
03 GIORNO PIC 99.
03 FILLER PIC X VALUE "/".
03 MESE PIC 99.
03 FILLER PIC X VALUE "/".
03 ANNO PIC 9(4).
01 CANCELLA-OK PIC 9.
01 WSTSC PIC S9(1).
01 WSC724 PIC S9(12).
BPNEW2 01 WCOMODO PIC S9(11)V9(002).
01 CHIAVE-ASCO.
03 WTIP PIC X.
03 WART PIC S9(6).
03 WNUM PIC S9(5).
BPNEW2 01 IMPASCO PIC S9(11)V9(002).
BPNEW2 01 WC0IMESA PIC S9(11)V9(002).
BPNEW2 01 WIMPPA PIC S9(11)V9(002).
01 ESISTE PIC S9.
01 WMSG PIC X(30).
01 WMSG2 PIC X(30).
01 WSUBAREA.
03 SC724 PIC 9(12).
03 PROGR PIC 9(4).
03 MATRW PIC 9(10).
03 PERIW PIC X(7).
BPOLD2* 03 IMPW PIC 9(9).
BPNEW2 03 IMPW PIC 9(7)V9(002).
BPINFO* CVG1110 Field IMPW contains class AMOUNT.
03 DATAW PIC X(10).
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ10.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ11.
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 CONTSUBF.
MOVE 9 TO WUTIL.
MOVE SPACES TO WMSG WMSG2.
PERFORM APRI THRU EX-APRI.
MOVE IND-OFF TO IN12 OF MA06-I-INDIC.
MOVE IND-OFF TO IN12 OF MQ02-I-INDIC.
MOVE 0 TO MA6SC7 OF MA06-I.
PERFORM CONTROLLO THRU EX-CONTROLLO
UNTIL IN12 OF MA06-I-INDIC = IND-ON.
PERFORM MAPPA THRU EX-MAPPA
UNTIL IN12 OF MQ02CTL-I-INDIC = IND-ON.
FINE.
ROLLBACK.
CLOSE VIDEO VIDEO2 ARTDEU DS79.
GOBACK.
APRI.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
OPEN I-O VIDEO2.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ11" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 2 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 "PRTAQ10" TO CM1-ERRPGM
MOVE 3 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 "PRTAQ10" TO CM1-ERRPGM
MOVE 4 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-APRI.
EXIT.
CONTROLLO.
WRITE REC-VIDEO FORMAT "MA06".
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 5 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
READ VIDEO FORMAT "MA06"
INDICATORS ARE AREA-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 6 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
BPEURO 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 "PRTAQ10" 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 IF AC0IMESA = 0
MOVE "NESSUNA CEDOLA ACQUISITA" TO MA6MSG OF MA06-O
GO TO EX-CONTROLLO
END-IF.
BPEURO MOVE AC0IMCOR TO IMPASCO.
BPEURO MOVE AC0IMESA TO WC0IMESA.
MOVE IND-ON TO IN12 OF MA06-I-INDIC.
EX-CONTROLLO.
EXIT.
MAPPA.
CLOSE VIDEO.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 8 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
CLOSE VIDEO2.
OPEN I-O VIDEO2.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ11" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 9 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
MOVE 0 TO WQUANTI CONTSUBF.
BPEURO MOVE 0 TO CANCELLA-OK WIMPPA.
MOVE WSC724 TO RDEUSC724.
MOVE 0 TO RDEUPROGR.
BPEURO START ARTDEU KEY IS NOT LESS EXTERNALLY-DESCRIBED-KEY
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "10"
AND F-STATUS NOT = "23"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 10 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
IF F-STATUS = "10" OR F-STATUS = "23"
MOVE IND-ON TO IN12 OF MQ02CTL-I-INDIC
MOVE IND-OFF TO IN12 OF MA05-I-INDIC
GO TO EX-MAPPA
END-IF
BPEURO READ ARTDEU NEXT.
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "10"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 11 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
PERFORM UNTIL F-STATUS NOT = "00" OR WQUANTI > 9990
OR RDEUSC724 NOT = WSC724
IF RDEUFLUTIL = 3 AND RDEUTIREC = 3
COMPUTE WQUANTI = WQUANTI + 1
MOVE RDEUMATAZI TO MQMATR OF MQ02-O
MOVE RDEUPERCED TO SUOPERI
MOVE CORRESPONDING SUOPERI TO MIOPERI
MOVE MIOPERI TO MQPERI OF MQ02-O
BPDSPF MOVE AIMPORPAG TO MQIMP OF MQ02-O
MOVE RDEUSC724 TO MQSC7 OF MQ02-O
MOVE RDEUPROGR TO MQPRG OF MQ02-O
MOVE ADATARISC TO SUADATA
MOVE CORRESPONDING SUADATA TO MIADATA
MOVE MIADATA TO MQDATA OF MQ02-O
ADD 1 TO CONTSUBF
BPDSPF WRITE SUBFILE REC-VIDEO2 FORMAT "MQ02"
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ11" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 12 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
END-IF
BPEURO READ ARTDEU NEXT
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "10"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 13 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
END-PERFORM.
IF WQUANTI = 0
MOVE IND-ON TO IN12 OF MQ02CTL-I-INDIC
MOVE IND-OFF TO IN12 OF MA05-I-INDIC
GO TO EX-MAPPA
END-IF.
MOVE CM1-DATACHIARO TO MQOGGI.
LEGGI.
MOVE IND-OFF TO IN12 OF MQ02CTL-I-INDIC
BPDSPF WRITE REC-VIDEO2 FORMAT "MQ02CODA".
BPDSPF WRITE REC-VIDEO2 FORMAT "MQ02CTL".
BPDSPF READ VIDEO2 FORMAT "MQ02CTL"
INDICATORS ARE MQ02CTL-I-INDIC.
IF IN12 OF MQ02CTL-I-INDIC = IND-ON
GO TO EX-MAPPA
END-IF.
BPDSPF READ SUBFILE VIDEO2 MODIFIED INTO WSUBAREA FORMAT "MQ02"
AT END
MOVE 0 TO WFINE
NOT AT END
MOVE 1 TO WFINE.
IF WFINE = 0
GO TO FINE
END-IF.
IF WFINE = 1
MOVE SPACES TO MQSCEL OF MQ02-I
BPDSPF REWRITE SUBFILE REC-VIDEO2 FORMAT IS "MQ02"
MOVE WSC724 TO MA5SC7
MOVE MATRW TO MA5MATR OF MA05-O
MOVE PERIW(1:2) TO MA5MEPER OF MA05-O
MOVE PERIW(4:4) TO MA5ANPER OF MA05-O
*** conservo in wcomodo il vecchio importo della cedola
BPDSPF MOVE IMPW TO MA5IMPPA OF MA05-O WCOMODO WIMPPA
MOVE DATAW(1:2) TO MA5GIORPA OF MA05-O
MOVE DATAW(4:2) TO MA5MESEPA OF MA05-O
MOVE DATAW(7:4) TO MA5ANNOPA OF MA05-O
MOVE 0 TO MODIFICATO FINITO
PERFORM MODIFICA THRU EX-MODIFICA
UNTIL IN12 OF MA05-I-INDIC = IND-ON
PERFORM LEGGO-SIT THRU EX-LEGGO-SIT
MOVE IND-OFF TO IN12 OF MQ02CTL-I-INDIC
MOVE IND-OFF TO IN12 OF MA05-I-INDIC
END-IF.
EX-MAPPA.
EXIT.
MODIFICA.
BPEURO CALL "PRTUT01" USING AREA-MN01.
MOVE IND-OFF TO IN04 OF MA05-I-INDIC.
MOVE IND-OFF TO IN11 OF MA05-I-INDIC.
WRITE REC-VIDEO FORMAT "MA05".
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 14 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
READ VIDEO FORMAT "MA05"
INDICATORS ARE AREA-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 15 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-MODIFICA
END-IF.
IF IN04 OF MA05-I-INDIC = IND-ON AND FINITO = 0
MOVE SPACES TO CM1-MSG
PERFORM CANCELLA THRU EX-CANCELLA
UNTIL IN05 OF MA08-I-INDIC = IND-ON
OR IN12 OF MA08-I-INDIC = IND-ON
IF CANCELLA-OK = 0
GO TO EX-MODIFICA
END-IF
END-IF.
IF MA5ANNOPA OF MA05-I IS = 0
OR MA5MATR OF MA05-I IS = 0
OR MA5MEPER OF MA05-I IS = 0
OR MA5ANPER 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
MOVE "Acquisizione fallita perchè incompleta" TO CM1-MSG
GO TO EX-MODIFICA
END-IF.
IF IN11 OF MA05-I-INDIC = IND-ON AND MODIFICATO = 0
MOVE MA5MATR OF MA05-I TO WMATAZI
BPDSPF MOVE MA5IMPPA OF MA05-I TO WIMPPA
MOVE 0 TO ESISTE
MOVE SPACES TO CM1-MSG
MOVE "CEDOLA VARIATA.-" TO WMSG2
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-MODIFICA
END-IF
* Aggiorno il record su ARTDEU con i dati della cedola
MOVE SC724 TO RDEUSC724
MOVE PROGR TO RDEUPROGR
BPEURO READ ARTDEU
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 16 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
MOVE MA5MATR OF MA05-I TO RDEUMATAZI
BPDSPF MOVE MA5IMPPA OF MA05-I TO AIMPORPAG
MOVE MA5ANNOPA OF MA05-I TO ANNO OF SUADATA
MOVE MA5MESEPA OF MA05-I TO MESE OF SUADATA
MOVE MA5GIORPA OF MA05-I TO GIORNO OF SUADATA
MOVE SUADATA TO ADATARISC
MOVE MA5ANPER OF MA05-I TO ANNOPERI
MOVE MA5MEPER OF MA05-I TO MESEPERI
MOVE PERI TO RDEUPERCED
MOVE 0 TO RDEUIMPDIS
BPEURO REWRITE REC-ARTDEU
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 17 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
END-IF.
** se il nuovo importo è diverso dal vecchio.....
** e se ho premuto F11 (conferma) o F4 (cancellazione)
IF (IN11 OF MA05-I-INDIC = IND-ON OR CANCELLA-OK = 1)
AND MODIFICATO = 0 AND FINITO = 0
MOVE 1 TO MODIFICATO
BPEURO IF WIMPPA IS NOT = WCOMODO
* Aggiorno il record su ASCO0079 con i dati della cedola
BPSCCL COMPUTE WC0IMESA = WC0IMESA - WCOMODO + WIMPPA
BPEURO MOVE WC0IMESA TO AC0IMESA
IF CANCELLA-OK = 1
COMPUTE AC0NRESA = AC0NRESA - 1
IF AC0NRESA = 0
COMPUTE AC0IMESA = 0
END-IF
END-IF
BPEURO REWRITE DS79-REC
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 18 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
PERFORM CONTROLLO2 THRU EX-CONTROLLO2
END-IF
END-IF.
IF CANCELLA-OK = 1 AND FINITO = 0
MOVE SC724 TO RDEUSC724
MOVE PROGR TO RDEUPROGR W-RINPROGR
BPEURO READ ARTDEU
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 19 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
BPEURO DELETE ARTDEU
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ARTDEU" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 20 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
PERFORM RINUMERA THRU EX-RINUMERA
END-IF.
IF F-STATUS = "00"
COMMIT
IF CANCELLA-OK = 1
MOVE "CEDOLA CANCELLATA.-" TO WMSG2
MOVE 1 TO FINITO
END-IF
ELSE
ROLLBACK
END-IF.
STRING WMSG2 WMSG DELIMITED BY SIZE INTO MA5MSG.
EX-MODIFICA.
EXIT.
CONTROLLO2.
BPEURO IF AC0IMESA = IMPASCO
MOVE "SC7/24 QUADRATO REGOLARMENTE" TO WMSG
EXEC SQL
UPDATE ARTDEU SET RDEUIMPDIS = AIMPORPAG,
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 PRTAQ10"
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 "PRTAQ10" TO CM1-ERRPGM
MOVE 21 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
COMMIT
END-IF.
BPEURO IF AC0IMESA > IMPASCO
MOVE "SC7/24 SQUADRATO!!" TO WMSG
END-IF.
EX-CONTROLLO2.
EXIT.
CANCELLA.
MOVE IND-OFF TO IN12 OF MA08-I-INDIC.
MOVE IND-OFF TO IN04 OF MA08-I-INDIC.
MOVE IND-OFF TO IN05 OF MA08-I-INDIC.
MOVE IND-OFF TO IN11 OF MA05-I-INDIC.
BPEURO MOVE 0 TO CANCELLA-OK.
WRITE REC-VIDEO FORMAT "MA08".
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 22 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
READ VIDEO FORMAT "MA08"
INDICATORS ARE AREA-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 23 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
IF IN05 OF MA08-I-INDIC = IND-ON
MOVE 1 TO CANCELLA-OK
MOVE 0 TO WIMPPA
END-IF.
IF IN12 OF MA08-I-INDIC = IND-ON
MOVE 0 TO CANCELLA-OK
END-IF.
EX-CANCELLA.
EXIT.
LEGGO-SIT.
BPEURO IF WIMPPA IS NOT = WCOMODO
MOVE WSC724 TO MA9SC7
BPDSPF MOVE IMPASCO TO MA9IMP
BPDSPF MOVE AC0IMESA TO MA9ACQ
WRITE REC-VIDEO FORMAT "MA09"
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 24 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
READ VIDEO FORMAT "MA09"
INDICATORS ARE AREA-INDIC
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ10" TO CM1-ERRFILE
MOVE "PRTAQ10" TO CM1-ERRPGM
MOVE 25 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
END-IF.
EX-LEGGO-SIT.
EXIT.
RINUMERA.
EXEC SQL
UPDATE ARTDEU SET RDEUPROGR = RDEUPROGR - 1
WHERE RDEUSC724 =:WSC724
AND RDEUPROGR > :W-RINPROGR
AND RDEUFLUTIL = 3 AND RDEUTIREC = 3
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.26 PGM PRTAQ10"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF.
EX-RINUMERA.
EXIT.
