- Dettagli
- Visite: 1573
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAN031.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : STAMPA PER PRESCRIZIONE - CON PARAMETRI *
* PGM CHIAMANTI : PRTAN02 *
* PGM CHIAMATI : -PRTUT02 *
* MAPPE : MRTAN011 *
* AREA DI INPUT : CRTMN01 - *
* *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MRTAN01 ASSIGN TO WORKSTATION-MRTAN01
ORGANIZATION IS TRANSACTION
ACCESS IS SEQUENTIAL
FILE STATUS IS F-STATUS.
SELECT SRTAN011 ASSIGN TO FORMATFILE-SRTAN011
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS F-STATUS.
DATA DIVISION.
FILE SECTION.
FD MRTAN01
LABEL RECORD IS OMITTED.
01 REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAN01.
FD SRTAN011.
01 REC-STAMPA.
COPY DDS-ALL-FORMAT OF SRTAN011.
*****************************************************************
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 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAN01.
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 WMPERI.
03 WMANNO PIC 9(4).
03 WMMESE PIC 99.
01 WDAEMI.
03 AA PIC 9(4).
03 MM PIC 99.
03 GG PIC 99.
01 WIMPDA2 PIC X(10).
01 WIMPA2 PIC X(10).
01 WIMPDA3 PIC 9(9).
01 WIMPA3 PIC 9(9).
01 STRINGA PIC X(1000).
01 POSTO PIC 9(4).
01 TOTALE PIC S9(6).
01 TOTALE2 PIC 9(6).
01 WMATRICOLA PIC S9(10).
01 CM2-MATRICOLA PIC S9(10).
01 CM2-D10PER PIC S9(6).
01 CM2-IMPRE PIC S9(13)V9(2).
01 FISSO2 PIC XX.
01 FISSO1 PIC X.
01 RIGA PIC 99.
01 WTOTRETT PIC S9(4).
01 WIMPRETT PIC S9(11)V9(2).
01 CM3-MATRICOLA PIC S9(10) VALUE 0.
01 WNOME PIC X(49).
01 WSTRA PIC X(12).
01 WVIA PIC X(26).
01 WNUMCIV PIC X(5).
01 WCAP PIC X(5).
01 WCOMUNE PIC X(30).
01 WPROV PIC X(2).
01 WMATRAZ.
03 WCOD PIC S9(2).
03 WMATR PIC S9(6).
03 WCRT PIC S9(2).
01 AREA-MATRICOLA.
02 MATRICOLA PIC 9(10).
02 RET-ELA PIC X(2).
02 AREA-COMODO.
03 APERTURE PIC 9.
03 CO-SEDE1 PIC X(15).
03 CO-INDIRIZ PIC X(32).
03 COM-CAP PIC X(5).
03 COM-COM PIC X(23).
03 COM-PRO PIC XX.
03 SW-CAR PIC 9.
03 CTR-START PIC 9.
03 FLAG-STAMPA PIC 9.
03 CTR PIC 99.
03 CTR-RAC PIC 9999.
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
01 AREA-COMUNE.
03 WPASS PIC X.
03 WIMPDA PIC S9(9).
03 WIMPA PIC S9(9).
03 WMATRICOLA PIC S9(10).
03 WD10PER PIC S9(6).
03 WGUIDA PIC 9.
03 WEMDA PIC S9(8).
03 WEMA PIC S9(8).
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01 AREA-COMUNE.
MAIN.
MOVE WIMPDA TO WIMPDA3.
MOVE WIMPA TO WIMPA3.
IF WIMPDA < 0
STRING "-" WIMPDA3 DELIMITED BY SIZE INTO WIMPDA2
ELSE
MOVE WIMPDA3 TO WIMPDA2
END-IF.
IF WIMPA < 0
STRING "-" WIMPA3 DELIMITED BY SIZE INTO WIMPA2
ELSE
MOVE WIMPA3 TO WIMPA2
END-IF.
MOVE '"' TO FISSO1.
MOVE '"%' TO FISSO2.
MOVE SPACES TO CM1-MSG STRINGA.
INITIALIZE AREA-MATRICOLA.
OPEN I-O MRTAN01.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAN01" TO CM1-ERRFILE
MOVE "PRTAN03" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
OPEN OUTPUT SRTAN011.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "SRTAN011" TO CM1-ERRFILE
MOVE "PRTAN03" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
PERFORM CONTA THRU EX-CONTA.
FINE.
CLOSE MRTAN01 SRTAN011.
GOBACK.
CONTA.
MOVE 37 TO POSTO.
MOVE SPACES TO STRINGA.
STRING "SELECT COUNT(*) FROM ARTDEFPRI WHERE"
DELIMITED BY SIZE INTO STRINGA.
STRING " RTCODDEF = 0 AND (RTFLSTAT = 0 OR RTFLSTAT = 8)"
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTIMPRE BETWEEN " WIMPDA2 " AND " WIMPA2
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
IF CM1-D10PER > 0
STRING " AND RTD10PER >= " CM1-D10PER
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WD10PER > 0
STRING " AND RTD10PER <= " WD10PER
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WEMDA > 0
STRING " AND RTDAEMI >= " WEMDA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WEMA > 0
STRING " AND RTDAEMI <= " WEMA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF CM1-MATRICOLA > 0
STRING " AND RTMATAZI = " CM1-MATRICOLA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WPASS = "S"
STRING " AND DIGITS(RTMATAZI) LIKE " FISSO2 WGUIDA FISSO1
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
STRING " AND RTRETTA = 1 "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
* DISPLAY STRINGA(1:500)
EXEC SQL
PREPARE S2 FROM :STRINGA
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERRORE SQL(" SQLERR ")-P.1 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-CONTA
END-IF
EXEC SQL
DECLARE C2 CURSOR FOR S2
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.2 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-CONTA
END-IF
EXEC SQL
OPEN C2
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.3 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-CONTA
END-IF
EXEC SQL
FETCH C2 INTO :TOTALE
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.4 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-CONTA
END-IF
EXEC SQL
CLOSE C2
END-EXEC.
IF TOTALE > 0
MOVE SPACES TO CM1-MSG
MOVE TOTALE TO NUMRETT
WRITE REC-VIDEO FORMAT "ESITO"
READ MRTAN01 FORMAT "ESITO"
INDICATORS ARE ESITO-I-INDIC
IF IN11 OF ESITO-I-INDIC = IND-ON AND TOTALE > 0
WRITE REC-VIDEO FORMAT "ATTENDI"
PERFORM PASSA-DATI THRU EX-PASSA-DATI
END-IF
ELSE
MOVE "NESSUNA RETTIFICA SELEZIONATA" TO CM1-MSG
END-IF.
EX-CONTA. EXIT.
PASSA-DATI.
MOVE 0 TO TOTALE2.
MOVE SPACES TO STRINGA.
MOVE 1 TO POSTO.
STRING "SELECT RTMATAZI, RTD10PER, RTIMPRE FROM ARTDEFPRI"
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " WHERE RTCODDEF = 0 AND (RTFLSTAT = 0"
" OR RTFLSTAT = 8)"
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
STRING " AND RTIMPRE BETWEEN " WIMPDA2 " AND " WIMPA2
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO.
IF CM1-D10PER > 0
STRING " AND RTD10PER >= " CM1-D10PER
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WD10PER > 0
STRING " AND RTD10PER <= " WD10PER
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WEMDA > 0
STRING " AND RTDAEMI >= " WEMDA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WEMA > 0
STRING " AND RTDAEMI <= " WEMA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF CM1-MATRICOLA > 0
STRING " AND RTMATAZI = " CM1-MATRICOLA
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
IF WPASS = "S"
STRING " AND DIGITS(RTMATAZI) LIKE " FISSO2 WGUIDA FISSO1
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
END-IF.
STRING " AND RTRETTA = 1 ORDER BY RTMATAZI "
DELIMITED BY SIZE INTO STRINGA WITH POINTER POSTO
* DISPLAY STRINGA(1:300)
EXEC SQL
PREPARE S3 FROM :STRINGA
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERRORE SQL(" SQLERR ")-P.1 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-PASSA-DATI
END-IF
EXEC SQL
DECLARE C3 CURSOR FOR S3
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.2 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-CONTA
END-IF
EXEC SQL
OPEN C3
END-EXEC.
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.3 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-CONTA
END-IF
COMPUTE RIGA = 60.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL
FETCH C3 INTO :CM2-MATRICOLA,:CM2-D10PER,:CM2-IMPRE
END-EXEC
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.4 PGM PRTAN03"
DELIMITED BY SIZE INTO CM1-MSG
GO TO EX-CONTA
END-IF
MOVE "00" TO RET-ELA
PERFORM STAMPA THRU EX-STAMPA
END-PERFORM.
MOVE 9999999999 TO MATRICOLA
MOVE 0 TO FLAG-STAMPA
CALL "RCSTAZ3" USING AREA-MATRICOLA
MOVE "PRONTA CODA DI STAMPA SRTAN011 + RACC." TO CM1-MSG
EXEC SQL
CLOSE C2
END-EXEC.
EX-PASSA-DATI. EXIT.
STAMPA.
IF (CM2-MATRICOLA NOT = CM3-MATRICOLA OR SQLCODE = 100)
IF WTOTRETT > 0
WRITE REC-STAMPA FROM RIGA
FORMAT IS "RIGA"
MOVE WTOTRETT TO STOTRETT
MOVE WIMPRETT TO SIMPRETT
WRITE REC-STAMPA FROM TOTALI-O
FORMAT IS "TOTALI"
MOVE 0 TO WTOTRETT WIMPRETT
END-IF
IF SQLCODE NOT = 100
MOVE CM2-MATRICOLA TO MATRICOLA
CALL "RCSTAZ3" USING AREA-MATRICOLA
IF RET-ELA NOT = "00"
MOVE RET-ELA TO CM1-FSTATUS
MOVE "LAZIEMAT" TO CM1-ERRFILE
MOVE "PRTAN03" TO CM1-ERRPGM
MOVE 5 TO CM1-RETCOD
MOVE "VA IN ERRORE IL PGM CHIAMATO RCSTAZ3" TO CM1-MSG
CALL "PRTUT02" USING AREA-MN01
END-IF
END-IF
END-IF.
IF (CM2-MATRICOLA NOT = CM3-MATRICOLA AND SQLCODE = 0)
MOVE CM2-MATRICOLA TO WMATRAZ
EXEC SQL
SELECT AZDENAZI, AZPRSTRA, AZNOMVIA, AZNUMCIV, AZCAP,
AZCOMUNE, AZSIGPRO
INTO :WNOME, :WSTRA, :WVIA, :WNUMCIV, :WCAP,
:WCOMUNE, :WPROV
FROM AAZIE009
WHERE AZCODPRO = :WCOD AND
AZMATAZI = :WMATR AND
AZCTRCOD = :WCRT
END-EXEC
MOVE 0 TO SQLCODE
END-IF.
IF F-STATUS = "00" AND SQLCODE = 0
IF RIGA > 43 OR (CM2-MATRICOLA NOT = CM3-MATRICOLA
AND SQLCODE = 0)
COMPUTE RIGA = 1
MOVE CM2-MATRICOLA TO CM3-MATRICOLA
MOVE CM1-DENOM-SEDE TO SSEDE
MOVE CM1-DATACHIARO TO SDATA
STRING WSTRA " " WVIA " " WNUMCIV DELIMITED BY SIZE
INTO SINDIR
STRING WCAP " " WCOMUNE " " WPROV DELIMITED BY SIZE
INTO SCITTA
MOVE WNOME TO SDENAZI
WRITE REC-STAMPA FROM TESTATA-O
FORMAT IS "TESTATA"
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "SRTAN011" TO CM1-ERRFILE
MOVE "PRTAN03" TO CM1-ERRPGM
MOVE 6 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF
END-IF.
IF SQLCODE = 0
MOVE CM2-MATRICOLA TO SMATR
MOVE CM2-D10PER TO SUOPERI
MOVE CORRESPONDING SUOPERI TO MIOPERI
MOVE MIOPERI TO SPERI
MOVE CM2-IMPRE TO SIMP
ADD CM2-IMPRE TO WIMPRETT
ADD 1 TO WTOTRETT
ADD 1 TO RIGA
WRITE REC-STAMPA FROM CORPO-O
FORMAT IS "CORPO"
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "SRTAN011" TO CM1-ERRFILE
MOVE "PRTAN04" TO CM1-ERRPGM
MOVE 7 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF
END-IF.
EX-STAMPA. EXIT.