- Dettagli
- Visite: 933
*$ COMMIT *CHG
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ041.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : VALIDAZIONE BCFC *
* PGM CHIAMANTI : PRTAQ03 *
* PGM CHIAMATI : PRTUT02 - UD2PD02 *
* MAPPE : MRTAQ011 *
* ARCHIVI : ASCO0079 - ARTDEU *
* AREA DI INPUT : CRTMN01 - CP2PD02 *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VIDEO2 ASSIGN TO WORKSTATION-MRTAQ01
ORGANIZATION IS TRANSACTION
ACCESS IS SEQUENTIAL
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 DS79.
DATA DIVISION.
FILE SECTION.
FD VIDEO2
LABEL RECORD IS OMITTED.
01 REC-VIDEO2.
COPY DDS-ALL-FORMAT OF MRTAQ01.
FD DS79.
01 DS79-REC.
COPY DDS-ALL-FORMATS OF ASCO0079.
****************************
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 PROGSC3 PIC S9(4).
01 DATASC3 PIC S9(8).
01 WSC3PR PIC S9(2).
01 WSC7 PIC S9(12).
01 WCONTO PIC S9(4).
01 WCONTO2 PIC S9(4).
01 WC0ANNU PIC S9(4).
01 WRAG1 PIC S9(11).
01 WMATR1 PIC X(10).
01 WPERI1 PIC S9(6).
BPOLD2*01 WIMPPA1 PIC S9(15).
BPNEW2 01 WIMPPA1 PIC S9(13)V9(002).
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
01 WDTPAGA1 PIC S9(8).
01 WSC31 PIC S9(8).
01 WPROGR1 PIC S9(4).
BPOLD2*01 IMPASCO PIC S9(13).
BPNEW2 01 IMPASCO PIC S9(11)V9(002).
BPINFO* CVG1110 Field IMPASCO contains class AMOUNT.
01 SUOPERI.
03 WANPER PIC 9(4).
03 WMEPER PIC 9(2).
01 SUADTPAGA.
03 WANNOPA PIC 9(4).
03 WMESEPA PIC 99.
03 WGIORPA PIC 99.
01 AREA-VIDEO2.
03 WRAG PIC 9(11).
03 WMATR PIC X(10).
03 WPERI.
05 WMEPER PIC 9(2).
05 WANPER PIC 9(4).
BPOLD2* 03 WIMPPA PIC 9(15).
BPNEW2 03 WIMPPA PIC 9(13)V9(002).
BPINFO* CVG1110 Field WIMPPA contains class AMOUNT.
03 WDTPAGA.
05 WGIORPA PIC 9(2).
05 WMESEPA PIC 9(2).
05 WANNOPA PIC 9(4).
03 WSC3 PIC 9(8).
03 WPROGR PIC 9(4).
03 WSC724 PIC 9(12).
03 WSC3N PIC 9(2).
01 CHIAVE-ASCO.
03 WTIP PIC X.
03 WART PIC S9(6).
03 WNUM PIC S9(5).
01 WC0NR102 PIC S9(5).
01 WC0NRESA2 PIC S9(5).
BPOLD2*01 WC0IMESA2 PIC S9(13).
BPNEW2 01 WC0IMESA2 PIC S9(11)V9(002).
BPINFO* CVG1110 Field WC0IMESA2 contains class AMOUNT.
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ01.
****************************************************************
* 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.
PERFORM APRI THRU EX-APRI.
MOVE IND-OFF TO IN12 OF MA03-I-INDIC.
BPDSPF MOVE LOW-VALUE TO AREA-VIDEO2.
BPINFO* CVG1011 In field AREA-VIDEO2 found the following classes:
BPINFO* CVG1010 Field WIMPPA contains class AMOUNT.
MOVE 0 TO PROGSC3.
MOVE 1 TO WCONTO WCONTO2.
MOVE CM1-SC3 TO DATASC3.
MOVE CM1-SC3PR TO WSC3PR.
MOVE CM1-SC7 TO WSC7 CHIAVE-ASCO.
EXEC SQL
SELECT MAX(RDEUNSC3) INTO :PROGSC3
FROM LRTDEU2
WHERE RDEUDTSC3 = :DATASC3 AND RDEUPRSC3 = :WSC3PR
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.1 PGM PRTAQ04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF.
* CONSERVO IN IMPASCO L'IMPORTO DELL'SC7/24 LETTO NEL DS079
MOVE WTIP TO AC0K1TIP
MOVE WART TO AC0K1ART
MOVE WNUM TO AC0K1NUM
BPEURO START DS79 KEY IS = EXTERNALLY-DESCRIBED-KEY
BPINFO* CVG1011 In field DS79 found the following classes:
BPINFO* CVG1010 Field AC0IMCOR contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMSC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMESA contains class AMOUNT.
BPINFO* CVG1010 Field AC0IRRIC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMDD contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMFS contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDM1E contains class AMOUNT.
BPINFO* CVG1010 Field AC0ESC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDDC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IFSC contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ04" 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.
BPEURO READ DS79 NEXT
BPINFO* CVG1011 In field DS79 found the following classes:
BPINFO* CVG1010 Field AC0IMCOR contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMSC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMESA contains class AMOUNT.
BPINFO* CVG1010 Field AC0IRRIC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMDD contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMFS contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDM1E contains class AMOUNT.
BPINFO* CVG1010 Field AC0ESC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDDC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IFSC contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ04" 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.
BPEURO MOVE AC0IMCOR TO IMPASCO.
BPINFO* CVG1118 Fields AC0IMCOR and IMPASCO contain the following
BPINFO* class AMOUNT
MOVE AC0NR10 TO WC0NR102.
MOVE AC0NRESA TO WC0NRESA2.
BPEURO MOVE AC0IMESA TO WC0IMESA2.
BPINFO* CVG1118 Fields AC0IMESA and WC0IMESA2 contain the following
BPINFO* class AMOUNT
MOVE AC0ANNU TO WC0ANNU.
IF AC0ANNU > 88
ADD 1900 TO WC0ANNU
ELSE
ADD 2000 TO WC0ANNU
END-IF.
* METTO A 1 IL CAMPO AC0SITSC PER PRESA IN CARICO
MOVE 1 TO AC0SITSC.
BPEURO REWRITE DS79-REC.
BPINFO* CVG1011 In field DS79-REC found the following classes:
BPINFO* CVG1010 Field AC0IMCOR contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMSC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMESA contains class AMOUNT.
BPINFO* CVG1010 Field AC0IRRIC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMDD contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMFS contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDM1E contains class AMOUNT.
BPINFO* CVG1010 Field AC0ESC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDDC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IFSC contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ04" 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.
EXEC SQL
DECLARE CUR1 CURSOR FOR
BPEURO SELECT RDEURIFRAG, RDEUMATAZI, RDEUPERCED, AIMPORPAG,
ADATARISC, RDEUDTSC3, RDEUNSC3
FROM LRTDEU2
WHERE RDEUDTSC3 = :DATASC3
AND RDEUPRSC3 = :WSC3PR
END-EXEC.
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
EXEC SQL
OPEN CUR1
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.3 PGM PRTAQ04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF.
IF SQLCODE = 0
EXEC SQL
FETCH CUR1
BPEURO INTO :WRAG1, :WMATR1, :WPERI1, :WIMPPA1, :WDTPAGA1,
:WSC31, :WPROGR1
END-EXEC
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.4 PGM PRTAQ04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL IN12 OF MA03-I-INDIC = IND-ON
END-IF.
FINE.
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL
CLOSE CUR1
END-EXEC.
CLOSE VIDEO2 DS79.
GOBACK.
APRI.
OPEN I-O VIDEO2.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ04" TO CM1-ERRPGM
MOVE 4 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.
OPEN I-O DS79.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ04" TO CM1-ERRPGM
MOVE 5 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.
EX-APRI.
EXIT.
SEQUENZA.
* Inizializzo gli indicatori
MOVE IND-OFF TO IN04 OF MA03-I-INDIC.
MOVE IND-OFF TO IN11 OF MA03-I-INDIC.
MOVE IND-OFF TO IN12 OF MA03-I-INDIC.
BPDSPF MOVE LOW-VALUE TO AREA-VIDEO2.
BPINFO* CVG1011 In field AREA-VIDEO2 found the following classes:
BPINFO* CVG1010 Field WIMPPA contains class AMOUNT.
* Copio i campi riempiti dalla Fetch nei campi dell'area-video
MOVE WRAG1 TO WRAG.
MOVE WMATR1 TO WMATR.
MOVE WPERI1 TO SUOPERI.
BPDSPF MOVE WIMPPA1 TO WIMPPA.
BPINFO* CVG1118 Fields WIMPPA1 and WIMPPA contain the following class
BPINFO* AMOUNT
MOVE WDTPAGA1 TO SUADTPAGA.
MOVE WSC31 TO WSC3.
MOVE WPROGR1 TO WPROGR.
MOVE CORRESPONDING SUOPERI TO WPERI.
MOVE CORRESPONDING SUADTPAGA TO WDTPAGA.
MOVE CM1-SC7 TO WSC724.
MOVE WSC3PR TO WSC3N.
BPDSPF MOVE AREA-VIDEO2 TO REC-VIDEO2.
BPINFO* CVG1011 In field AREA-VIDEO2 found the following classes:
BPINFO* CVG1010 Field WIMPPA contains class AMOUNT.
BPINFO* CVG1011 In field REC-VIDEO2 found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
BPDSPF WRITE REC-VIDEO2 FORMAT "MA03".
BPINFO* CVG1011 In field REC-VIDEO2 found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ04" TO CM1-ERRPGM
MOVE 6 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 VIDEO2 FORMAT "MA03"
INDICATORS ARE AREA-INDIC.
BPINFO* CVG1011 In field VIDEO2 found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ04" TO CM1-ERRPGM
MOVE 7 TO CM1-RETCOD
ROLLBACK
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.
* col tasto F12 esco dalla validazione
IF IN12 OF MA03-I-INDIC = IND-ON
GO TO EX-SEQUENZA
END-IF.
* l'unico campo che posso variare è l'importo e lo conservo
BPDSPF MOVE MA0IMPPA OF MA03-I TO WIMPPA WIMPPA1.
BPINFO* CVG1110 Field MA0IMPPA contains class AMOUNT.
BPINFO* CVG1110 Field WIMPPA contains class AMOUNT.
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
* col tasto F4 cancello la cedola da LRTDEU2
IF IN04 OF MA03-I-INDIC = IND-ON
EXEC SQL
DELETE FROM LRTDEU2
WHERE RDEUDTSC3 = :DATASC3 AND
RDEUNSC3 = :WPROGR1 AND RDEUPRSC3 = :WSC3PR
END-EXEC
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.8 PGM PRTAQ04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF
END-IF.
* col tasto F11 confermo i dati della mappa
IF IN11 OF MA03-I-INDIC = IND-ON
BPDSPF MOVE MA0IMPPA OF MA03-I TO WIMPPA WIMPPA1
BPINFO* CVG1110 Field MA0IMPPA contains class AMOUNT.
BPINFO* CVG1110 Field WIMPPA contains class AMOUNT.
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
* scrivo i dati nel record di LRTDEU2
EXEC SQL
BPEURO UPDATE LRTDEU2 SET AIMPORPAG = :WIMPPA1,
RDEUIMPDIS = :WIMPPA1,
RDEUSC724 = :WSC7,
RDEUPROGR = :WCONTO,
RDEUNSC3 = :WCONTO,
BPCONS RDEUSTSC3 = 1,
RDEUANCO = :WC0ANNU,
RDEUFLUTIL = 0
WHERE RDEUDTSC3 = :DATASC3 AND RDEUNSC3 = :WPROGR1
AND RDEUPRSC3 = :WSC3PR
END-EXEC
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.9 PGM PRTAQ04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF
* Aggiorno il record su ASCO0079 con i dati della cedola
COMPUTE WC0NRESA2 = WC0NRESA2 + 1
BPSCCL COMPUTE WC0IMESA2 = WC0IMESA2 + WIMPPA1
BPINFO* CVG1110 Field WC0IMESA2 contains class AMOUNT.
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
MOVE WC0NRESA2 TO AC0NRESA
BPEURO MOVE WC0IMESA2 TO AC0IMESA
BPINFO* CVG1118 Fields WC0IMESA2 and AC0IMESA contain the following
BPINFO* class AMOUNT
BPEURO REWRITE DS79-REC
BPINFO* CVG1011 In field DS79-REC found the following classes:
BPINFO* CVG1010 Field AC0IMCOR contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMSC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMESA contains class AMOUNT.
BPINFO* CVG1010 Field AC0IRRIC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMDD contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMFS contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDM1E contains class AMOUNT.
BPINFO* CVG1010 Field AC0ESC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDDC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IFSC contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ04" TO CM1-ERRPGM
MOVE 8 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
END-IF.
* Se ho premuto F4 o F11, inizializzo l'area per nuova Fetch
IF IN04 OF MA03-I-INDIC = IND-ON OR
IN11 OF MA03-I-INDIC = IND-ON
ADD 1 TO WCONTO2
IF IN11 OF MA03-I-INDIC = IND-ON
ADD 1 TO WCONTO
END-IF
BPEURO MOVE 0 TO WRAG1 WMATR1 WPERI1 WIMPPA1 WDTPAGA1 WSC31
WPROGR1
BPINFO* CVG1110 Field WIMPPA1 contains class AMOUNT.
* controllo se le cedole da validare sono finite
* se sono finite, controllo il valore di AC0IMESA con il valore
* di AC0IMCOR -già letto e conservato in IMPASCO
* se la quadrartura regge consolido i dati negli archivi
IF WCONTO2 > PROGSC3
* SE L'SC7/24 QUADRA METTO A 2 A79SITSC:CONSOLIDATO
* E CONSOLIDO LE MODIFICHE AGLI ARCHIVI
BPEURO IF WC0IMESA2 = IMPASCO AND WC0NRESA2 = WC0NR102
BPINFO* CVG1110 Field WC0IMESA2 contains class AMOUNT.
BPINFO* CVG1110 Field IMPASCO contains class AMOUNT.
MOVE 2 TO AC0SITSC
BPEURO REWRITE DS79-REC
BPINFO* CVG1011 In field DS79-REC found the following classes:
BPINFO* CVG1010 Field AC0IMCOR contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMSC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMESA contains class AMOUNT.
BPINFO* CVG1010 Field AC0IRRIC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMDD contains class AMOUNT.
BPINFO* CVG1010 Field AC0IMFS contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDM1E contains class AMOUNT.
BPINFO* CVG1010 Field AC0ESC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IDDC contains class AMOUNT.
BPINFO* CVG1010 Field AC0IFSC contains class AMOUNT.
IF F-STATUS NOT EQUAL "00"
ROLLBACK
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ04" TO CM1-ERRPGM
MOVE 9 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
EXEC SQL COMMIT END-EXEC
MOVE IND-ON TO IN12 OF MA03-I-INDIC
MOVE "SC7/24 VALIDATO CON SUCCESSO"
TO CM1-MSG
GO TO EX-SEQUENZA
ELSE
MOVE "SC7/24 SQUADRATO - IMPOSSIBILE VALIDARE"
TO CM1-MSG
EXEC SQL ROLLBACK END-EXEC
MOVE IND-ON TO IN12 OF MA03-I-INDIC
GO TO EX-SEQUENZA
END-IF
END-IF
* continuo il ciclo della Fetch
EXEC SQL
FETCH CUR1
INTO :WRAG1, :WMATR1, :WPERI1, :WIMPPA1, :WDTPAGA1,
:WSC31, :WPROGR1
END-EXEC
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.13 PGM PRTAQ04"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF
END-IF.
EX-SEQUENZA.
EXIT.
