• Stampa

Dettagli

Visite: 857

IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ051.
*--------------------------------------------------------------*
*               PROGETTO RETTIFICHE                            *
*               -------------------                            *
* AUTORE       : FRANCO D'AMICO  C.O.DI MARSALA                *
*                                                              *
* FUNZIONE     :  SCELTA PARAMETRI PER VARIAZ.DOCUMENTI DIVERSI*
* PGM CHIAMANTI : PRTMN01                                      *
* PGM CHIAMATI  : PRTAQ06-PRTUT02-PRTAQ08                      *
* MAPPE         : MRTAQ051                                     *
* AREA DI INPUT : CRTMN01 -                                    *
*                                                              *
*--------------------------------------------------------------*

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
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.


DATA DIVISION.

FILE SECTION.
FD   VIDEO
LABEL RECORD IS OMITTED.
01   REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAQ05.

*****************************************************************
WORKING-STORAGE SECTION.
77 F-STATUS       PIC XX.
01  IND-ON          PIC 1 VALUE B"1".
01  IND-OFF         PIC 1 VALUE B"0".
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ05.
01 WDATA.
03 WANNO      PIC 9(4).
03 WMESE      PIC 99.
03 WGIORNO    PIC 99.
01  WMPERI.
03 WMANNO  PIC 9(4).
03 WMMESE  PIC 99.
01  W-STRINGA       PIC X(76).
01  TESTO REDEFINES W-STRINGA.
02 MIASTRINGA  OCCURS 76 TIMES
INDEXED BY INDEX1.
03 ALFA    PIC X.
01 CONT          PIC 99 VALUE 0.
01 CONT2         PIC 99 VALUE 0.
LINKAGE SECTION.
BPINFO* CVR2019 Found explicit reference to library or file DCBCPY;
BPINFO*         manual handling may be required
BPCHCK  COPY CRTMN01 OF DCBCPY.
*****************************************************************
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   CM1-MATRICOLA CM1-D10PER CM1-PROPER WMPERI
BPEURO           CM1-IMPDA CM1-IMPA CM1-EMIDA.
BPINFO* CVG1110 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1110 Field CM1-IMPA contains class AMOUNT.
MOVE SPACES TO CM1-COD-FISC.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ05" TO CM1-ERRFILE
MOVE "PRTAQ05" 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.
MOVE IND-OFF TO IN12 OF MQ05-I-INDIC.
MOVE SPACES TO CM1-MSG.
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL IN12 OF MQ05-I-INDIC = IND-ON.
FINE.
CLOSE VIDEO.
GOBACK.

SEQUENZA.
MOVE CM1-DATACHIARO TO MQ5OGGI OF MQ05-O.
MOVE SPACES TO MQ5CODFISC OF MQ05-I.
MOVE IND-OFF TO IN12 OF MQ05-I-INDIC.
BPDSPF       WRITE REC-VIDEO FORMAT "MQ05".
BPINFO* CVG1011 In field REC-VIDEO found the following classes:
BPINFO* CVG1010 Field MQ5IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field MQ5IMPA contains class AMOUNT.
BPDSPF       READ VIDEO FORMAT "MQ05"
INDICATORS ARE AREA-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 IN12  OF MQ05-I-INDIC = IND-ON
MOVE SPACES TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
IF MQ5SC7 OF MQ05-I IS NUMERIC
IF MQ5SC7 OF MQ05-I IS > 0
MOVE MQ5SC7 OF MQ05-I TO CM1-SC7
ELSE
MOVE 0 TO CM1-SC7
END-IF
ELSE
MOVE 0 TO CM1-SC7
END-IF.
IF MQ5PROG OF MQ05-I IS NUMERIC
IF MQ5PROG OF MQ05-I IS > 0
MOVE MQ5PROG OF MQ05-I TO CM1-PROG
ELSE
MOVE 0 TO CM1-PROG
END-IF
ELSE
MOVE 0 TO CM1-PROG
END-IF.
MOVE SPACES TO MQ5MSG OF MQ05-O.
IF MQ5MATR OF MQ05-I IS NUMERIC
IF MQ5MATR OF MQ05-I IS > 0
MOVE MQ5MATR OF MQ05-I TO CM1-MATRICOLA
ELSE
MOVE 0 TO CM1-MATRICOLA
END-IF
ELSE
MOVE 0 TO CM1-MATRICOLA
END-IF.
IF MQ5ANNO OF MQ05-I IS NUMERIC AND MQ5ANNO OF MQ05-I
IS > 0
AND (MQ5MESE OF MQ05-I IS NOT NUMERIC OR MQ5MESE
OF MQ05-I IS < 1 OR MQ5MESE OF MQ05-I IS > 12)
MOVE "MESE DEL PERIODO NON VALIDO!" TO W-STRINGA
MOVE 0 TO CONT
PERFORM RICERCA THRU EX-RICERCA
VARYING INDEX1 FROM 76 BY -1
UNTIL INDEX1 < 1 OR ALFA(INDEX1) NOT EQUAL TO SPACE
PERFORM SCRIVI THRU EX-SCRIVI
GO TO EX-SEQUENZA
END-IF.
IF MQ5MESE OF MQ05-I IS NUMERIC
AND MQ5ANNO OF MQ05-I IS NUMERIC
IF MQ5MESE OF MQ05-I IS > 0
AND MQ5ANNO OF MQ05-I IS > 0
MOVE MQ5MESE OF MQ05-I TO WMMESE
MOVE MQ5ANNO OF MQ05-I TO WMANNO
ELSE
MOVE 0 TO WMMESE WMANNO
END-IF
ELSE
MOVE 0 TO WMMESE WMANNO
END-IF.
MOVE WMPERI TO CM1-D10PER.
MOVE MQ5CODFISC OF MQ05-I TO CM1-COD-FISC.
BPDSPF       IF MQ5IMPDA OF MQ05-I IS NOT NUMERIC
BPINFO* CVG1110 Field MQ5IMPDA contains class AMOUNT.
BPDSPF          MOVE 0 TO MQ5IMPDA  OF MQ05-I
BPINFO* CVG1110 Field MQ5IMPDA contains class AMOUNT.
END-IF.
BPDSPF       IF MQ5IMPA OF MQ05-I IS NOT NUMERIC
BPINFO* CVG1110 Field MQ5IMPA contains class AMOUNT.
BPDSPF          MOVE 0 TO MQ5IMPA  OF MQ05-I
BPINFO* CVG1110 Field MQ5IMPA contains class AMOUNT.
END-IF.
BPDSPF       IF MQ5IMPA OF MQ05-I < MQ5IMPDA OF MQ05-I
AND MQ5IMPA OF MQ05-I IS > 0
BPINFO* CVG1110 Field MQ5IMPA contains class AMOUNT.
BPINFO* CVG1110 Field MQ5IMPDA contains class AMOUNT.
MOVE "RANGE IMPORTO NON VALIDO!" TO W-STRINGA
MOVE 0 TO CONT
PERFORM RICERCA THRU EX-RICERCA
VARYING INDEX1 FROM 76 BY -1
UNTIL INDEX1 < 1 OR ALFA(INDEX1) NOT EQUAL TO SPACE
PERFORM SCRIVI THRU EX-SCRIVI
GO TO EX-SEQUENZA
END-IF.
BPDSPF       MOVE MQ5IMPDA OF MQ05-I TO CM1-IMPDA.
BPINFO* CVG1118 Fields MQ5IMPDA and CM1-IMPDA contain the following
BPINFO*         class AMOUNT
BPDSPF       MOVE MQ5IMPA OF MQ05-I TO CM1-IMPA.
BPINFO* CVG1118 Fields MQ5IMPA and CM1-IMPA contain the following
BPINFO*         class AMOUNT
IF MQ5AAAA OF MQ05-I IS NUMERIC AND MQ5AAAA OF MQ05-I
IS > 0
AND (MQ5MM OF MQ05-I IS NOT NUMERIC OR MQ5MM
OF MQ05-I IS < 1 OR MQ5MM OF MQ05-I IS > 12
OR MQ5GG OF MQ05-I > 31)
MOVE "DATA FORMALMENTE ERRATA!" TO W-STRINGA
MOVE 0 TO CONT
PERFORM RICERCA THRU EX-RICERCA
VARYING INDEX1 FROM 76 BY -1
UNTIL INDEX1 < 1 OR ALFA(INDEX1) NOT EQUAL TO SPACE
PERFORM SCRIVI THRU EX-SCRIVI
GO TO EX-SEQUENZA
END-IF.
IF MQ5GG OF MQ05-I IS NUMERIC AND
MQ5MM OF MQ05-I IS NUMERIC AND
MQ5AAAA OF MQ05-I IS NUMERIC
MOVE MQ5GG OF MQ05-I TO WGIORNO
MOVE MQ5MM OF MQ05-I TO WMESE
MOVE MQ5AAAA OF MQ05-I TO WANNO
MOVE WDATA TO CM1-EMIDA
END-IF.
MOVE SPACES TO W-STRINGA CM1-MSG MQ5MSG.
BPEURO       CALL CM1-CHIAMANTE 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 CM1-MSG  TO W-STRINGA.
MOVE 0 TO CONT.
PERFORM RICERCA THRU EX-RICERCA
VARYING INDEX1 FROM 76 BY -1
UNTIL INDEX1 < 1 OR ALFA(INDEX1) NOT EQUAL TO SPACE.
PERFORM SCRIVI THRU EX-SCRIVI.
EX-SEQUENZA.
EXIT.

RICERCA.
SEARCH MIASTRINGA
AT END
GO TO EX-RICERCA
WHEN ALFA(INDEX1) IS EQUAL TO SPACE
ADD 1 TO CONT.
EX-RICERCA.
EXIT.

SCRIVI.
COMPUTE CONT2 = CONT / 2.
IF CONT2 = 0
MOVE 1 TO CONT2
END-IF.
STRING  W-STRINGA
DELIMITED BY SIZE INTO MQ5MSG
WITH POINTER CONT2.
EX-SCRIVI.
EXIT.