- Dettagli
- Visite: 763
*$ COMMIT *CHG
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ035.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : RICHIESTA VALIDAZIONE BCFC. *
* *
* PGM CHIAMANTI : PRTMN01 *
* PGM CHIAMATI : PRTAQ04 *
* MAPPE : MRTAQ011 *
* AREA DI INPUT : CRTMN01 - *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VIDEO 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 VIDEO
LABEL RECORD IS OMITTED.
01 REC-VIDEO.
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 DTSC3 PIC S9(8).
01 DATASC3 PIC S9(8).
01 WSC3PR PIC S9(2).
01 WCONTO PIC S9(1).
01 SQLERR PIC S9(5).
01 CHIAVE-ASCO.
03 WTIP PIC X.
03 WART PIC S9(6).
03 WNUM PIC S9(5).
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 0 TO DTSC3 DATASC3 WCONTO WART WNUM.
MOVE IND-OFF TO IN12 OF MA04-I-INDIC.
IF F-STATUS = "00"
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL IN12 OF MA04-I-INDIC = IND-ON
END-IF.
FINE.
CLOSE VIDEO DS79.
MOVE SPACES TO CM1-MSG.
GOBACK.
APRI.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ03" 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.
OPEN INPUT DS79.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ03" 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.
EX-APRI.
EXIT.
SEQUENZA.
MOVE CM1-MSG TO MAMSG OF MA04-O.
BPDSPF WRITE REC-VIDEO FORMAT "MA04".
BPINFO* CVG1011 In field REC-VIDEO found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
BPDSPF READ VIDEO FORMAT "MA04"
INDICATORS ARE AREA-INDIC.
BPINFO* CVG1011 In field VIDEO found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
IF IN12 OF MA04-I-INDIC = IND-ON
GO TO EX-SEQUENZA
END-IF.
IF MASC3 OF MA04-I IS NOT NUMERIC
OR MASC3 OF MA04-I IS = 0
MOVE "DIGITA IL N° SC3 DA VALIDARE" TO CM1-MSG
GO TO EX-SEQUENZA
ELSE
MOVE MASC3 OF MA04-I TO CM1-SC3
END-IF.
IF MASC3N OF MA04-I IS NOT NUMERIC
OR MASC3N OF MA04-I IS = 0
MOVE "DIGITA IL PROGR. SC3 DA VALIDARE" TO CM1-MSG
EUMAN * MOVE LOW-VALUE TO CM1-SC3PR
EUMAN MOVE 0 TO CM1-SC3PR
GO TO EX-SEQUENZA
ELSE
MOVE MASC3N OF MA04-I TO CM1-SC3PR
END-IF.
IF MASC724 OF MA04-I IS NOT NUMERIC
OR MASC724 OF MA04-I IS = 0
MOVE "DIGITA IL N° SC7/24 DA VALIDARE" TO CM1-MSG
EUMAN * MOVE LOW-VALUE TO CM1-SC7
EUMAN MOVE 0 TO CM1-SC7
GO TO EX-SEQUENZA
ELSE
MOVE MASC724 OF MA04-I TO CM1-SC7
END-IF.
MOVE SPACES TO CM1-MSG.
MOVE CM1-SC3 TO DATASC3.
MOVE CM1-SC3PR TO WSC3PR.
MOVE CM1-SC7 TO CHIAVE-ASCO.
* CERCO IN ARTDEU SE ESISTE L'SC3 DIGITATO
EXEC SQL
SELECT RDEUDTSC3 INTO :DTSC3
FROM ARTDEU
WHERE RDEUDTSC3 = :DATASC3
AND RDEUPRSC3 = :WSC3PR
END-EXEC.
* SE NON ESISTE IL N° SC3 HO 0 IN DTSC3
* SE ESISTE CERCO ANCHE IN ASCO0079 SE ESISTE L'SC7/24
IF DTSC3 IS = 0
MOVE "N° SC3 NON PRESENTE IN ARCHIVIO" TO CM1-MSG
GO TO EX-SEQUENZA
ELSE
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" AND F-STATUS NOT = "10" AND
F-STATUS NOT = "23"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ03" 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 F-STATUS = "10" OR F-STATUS = "23"
MOVE "SC7/24 NON PRESENTE IN ARCHIVIO" TO CM1-MSG
GO TO EX-SEQUENZA
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" AND F-STATUS NOT = "10" AND
F-STATUS NOT = "23"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "ASCO0079" TO CM1-ERRFILE
MOVE "PRTAQ03" 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 AC0SITSC = 0
BPEURO CALL "PRTAQ04" 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.
MOVE IND-ON TO IN12 OF MA04-I-INDIC
ELSE
MOVE "SC3 GIA' VALIDATO" TO CM1-MSG
END-IF
END-IF.
EX-SEQUENZA.
EXIT.
