- Dettagli
- Visite: 871
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ161.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : CONSULTAZIONE DOCUMENTI DIVERSI *
* PGM CHIAMANTI : PRTMN01 *
* PGM CHIAMATI : PRTUT02 *
* MAPPE : MRTAQ061 *
* AREA DI INPUT : CRTMN01 *
* *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MRTAQ06 ASSIGN TO WORKSTATION-MRTAQ06
ORGANIZATION IS TRANSACTION
ACCESS IS DYNAMIC
RELATIVE KEY IS CONTSUBF
FILE STATUS IS F-STATUS.
DATA DIVISION.
FILE SECTION.
FD MRTAQ06
LABEL RECORD IS omitted.
01 REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAQ06.
*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
EXEC SQL
INCLUDE SQLCA
END-EXEC.
01 SQLERR PIC 9(5).
01 CONTSUBF PIC 9(5).
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 MRTAQ06.
01 SUOPERI.
03 ANNO PIC 9(4).
03 MESE PIC 99.
01 MIOPERI.
03 MESE PIC 99.
03 ANNO PIC 9(4).
01 MIA-AREA.
03 WMATRICOLA PIC X(10).
03 WSC7 PIC S9(12).
03 WDATA PIC S9(8).
03 STRINGA PIC X(300).
03 POSTO PIC 9(4).
01 FISSO1 PIC X VALUE '"'.
01 WMATR PIC X(10).
01 WIMP PIC S9(13)V9(2).
01 WPERI PIC S9(6).
01 WSC724 PIC S9(12).
01 WVERS PIC S9(8).
01 WPROG PIC S9(4).
01 WFINE PIC 9.
01 WMSG PIC X(74).
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01.
MAIN.
INITIALIZE MIA-AREA.
MOVE '"' TO FISSO1.
MOVE SPACES TO CM1-MSG.
MOVE 0 TO CONTSUBF.
OPEN I-O MRTAQ06.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAQ06" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
MOVE IND-OFF TO IN12 OF MSEL-I-INDIC.
MOVE SPACES TO CM1-MSG.
PERFORM LEGGI-MAPPA THRU EX-LEGGI-MAPPA
UNTIL IN12 OF MSEL-I-INDIC = IND-ON.
FINE.
MOVE SPACES TO CM1-MSG.
CLOSE MRTAQ06.
GOBACK.
LEGGI-MAPPA.
CLOSE MRTAQ06.
OPEN I-O MRTAQ06.
MOVE 0 TO MQ6MATR OF MSEL-I MQ6SC7 OF MSEL-I.
MOVE 0 TO MQ6GG OF MSEL-I MQ6MM OF MSEL-I.
MOVE 0 TO MQ6AAAA OF MSEL-I CONTSUBF.
INITIALIZE MIA-AREA.
CALL "PRTUT03" USING AREA-MN01.
MOVE CM1-MSG TO MQ6MSG.
MOVE CM1-DATACHIARO TO MQ6OGGI OF MSEL-O
MOVE IND-OFF TO IN12 OF MSEL-I-INDIC.
MOVE IND-OFF TO IN03 OF MSEL-I-INDIC.
WRITE REC-VIDEO FORMAT "MSEL"
INDICATORS ARE AREA-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAQ06" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
READ MRTAQ06 FORMAT "MSEL"
INDICATORS ARE AREA-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAQ06" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 3 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
IF IN12 OF MSEL-I-INDIC = IND-ON
MOVE SPACES TO CM1-MSG
GO TO EX-LEGGI-MAPPA
END-IF.
MOVE SPACES TO MQ6MSG OF MSEL-O CM1-MSG
IF MQ6MATR OF MSEL-I IS > 0
MOVE MQ6MATR OF MSEL-I TO CM1-MATRICOLA WMATRICOLA
ELSE
MOVE 0 TO CM1-MATRICOLA
END-IF.
IF MQ6SC7 OF MSEL-I IS > 0
MOVE MQ6SC7 OF MSEL-I TO WSC7
ELSE
MOVE 0 TO CM1-SC7
END-IF.
IF MQ6AAAA OF MSEL-I IS NUMERIC AND MQ6AAAA OF MSEL-I
IS > 0
AND (MQ6MM OF MSEL-I IS NOT NUMERIC OR MQ6MM
OF MSEL-I IS < 1 OR MQ6MM OF MSEL-I IS > 12)
MOVE "MESE NON VALIDO!" TO CM1-MSG
GO TO EX-LEGGI-MAPPA
END-IF.
IF MQ6AAAA OF MSEL-I IS NUMERIC AND MQ6AAAA OF MSEL-I
IS > 0
AND (MQ6GG OF MSEL-I IS NOT NUMERIC OR MQ6GG
OF MSEL-I IS < 1 OR MQ6GG OF MSEL-I IS > 31)
MOVE "GIORNO NON VALIDO!" TO CM1-MSG
GO TO EX-LEGGI-MAPPA
END-IF.
IF MQ6AAAA OF MSEL-I > 0
STRING MQ6AAAA OF MSEL-I MQ6MM OF MSEL-I MQ6GG OF MSEL-I
DELIMITED BY SIZE INTO WDATA
END-IF.
PERFORM PASSA-DATI THRU EX-PASSA-DATI.
EX-LEGGI-MAPPA. EXIT.
PASSA-DATI.
MOVE SPACES TO STRINGA.
COMPUTE POSTO = 1.
STRING "SELECT RDEUMATAZI, AIMPORPAG, RDEUPERCED, "
"RDEUSC724, ADATARISC, RDEUPROGR FROM DMADSNEW/ARTDEU "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
STRING " WHERE RDEUFLDD = 1 "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
IF WMATRICOLA > 0
STRING " AND RDEUMATAZI = " FISSO1 WMATRICOLA FISSO1
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WSC7 > 0
STRING " AND RDEUSC724 = " WSC7
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WDATA > 0
STRING " AND ADATARISC = " WDATA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
STRING " ORDER BY RDEUMATAZI "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
* DISPLAY STRINGA
EXEC SQL
PREPARE S3 FROM :STRINGA
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 4 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.4 PGM PRTAQ16"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF
EXEC SQL
DECLARE C3 CURSOR FOR S3
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 5 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.5 PGM PRTAQ16"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF
EXEC SQL
OPEN C3
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
MOVE SPACES TO CM1-MSG
MOVE "SQL-DINAMICO" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 6 TO CM1-RETCOD
STRING "ERR.SQL(" SQLERR ")-P.6 PGM PRTAQ16"
DELIMITED BY SIZE INTO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL
FETCH C3 INTO :WMATR,:WIMP,:WPERI,:WSC724,:WVERS,:WPROG
END-EXEC
IF SQLCODE = 0
PERFORM SCRIVI-MAPPA THRU EX-SCRIVI-MAPPA
END-IF
END-PERFORM.
EXEC SQL
CLOSE C3
END-EXEC.
IF CONTSUBF > 0
MOVE 1 TO CONTSUBF
PERFORM SCRIVI-LEGGI THRU EX-SCRIVI-LEGGI
UNTIL IN12 OF MQ06CTL-I-INDIC = IND-ON
ELSE
MOVE "NESSUN DOCUMENTO DIVERSO SELEZIONATO" TO CM1-MSG
END-IF.
EX-PASSA-DATI. EXIT.
SCRIVI-MAPPA.
ADD 1 TO CONTSUBF
IF CONTSUBF > 9990
GO TO EX-SCRIVI-MAPPA
END-IF.
MOVE WMATR TO MQ6MATR OF MQ06-O
MOVE WIMP TO MQ6IMP OF MQ06-O
MOVE WPERI TO SUOPERI
MOVE CORRESPONDING SUOPERI TO MIOPERI
MOVE MIOPERI TO MQ6PERI OF MQ06-O
MOVE WSC724 TO MQ6SC7 OF MQ06-O
MOVE WVERS TO MQ6VERS OF MQ06-O
MOVE WPROG TO MQ6PROGR OF MQ06-O
WRITE SUBFILE REC-VIDEO FORMAT "MQ06"
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "22"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAQ06" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 8 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-SCRIVI-MAPPA. EXIT.
SCRIVI-LEGGI.
WRITE REC-VIDEO FORMAT "MCODA"
MOVE CM1-DATACHIARO TO MQ6DATA.
WRITE REC-VIDEO FORMAT "MQ06CTL"
INDICATORS ARE MQ06CTL-I-INDIC.
READ MRTAQ06 FORMAT "MQ06CTL"
INDICATORS ARE MQ06CTL-I-INDIC.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE SPACES TO CM1-MSG
MOVE "MRTAQ06" TO CM1-ERRFILE
MOVE "PRTAQ16" TO CM1-ERRPGM
MOVE 9 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
IF IN12 OF MQ06CTL-I-INDIC = IND-ON
GO TO EX-SCRIVI-LEGGI
END-IF.
EX-SCRIVI-LEGGI.
EXIT.
