- Dettagli
- Visite: 1029
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAN021.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : SCELTA PARAMETRI PER ANNULLAMENTO *
* PGM CHIAMANTI : PRTAN01 *
* PGM CHIAMATI : *
* MAPPE : MRTAN011 *
* AREA DI INPUT : CRTMN01 - *
* *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MRTAN01 ASSIGN TO WORKSTATION-MRTAN01
ORGANIZATION IS TRANSACTION
ACCESS 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.
*****************************************************************
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 MRTAN01.
01 WMPERI.
03 WMANNO PIC 9(4).
03 WMMESE PIC 99.
01 WEMPERI.
03 WEMAA PIC 9(4).
03 WEMMM PIC 99.
03 WEMGG PIC 99.
01 W-STRINGA PIC X(38).
01 TESTO REDEFINES W-STRINGA.
02 MIASTRINGA OCCURS 38 TIMES
INDEXED BY INDEX1.
03 ALFA PIC X.
01 CONT PIC 99 VALUE 0.
01 CONT2 PIC 99 VALUE 0.
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).
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01.
MAIN.
INITIALIZE CM1-MATRICOLA CM1-D10PER CM1-PROPER WMPERI.
MOVE 0 TO WEMPERI WEMDA WEMA.
OPEN I-O MRTAN01.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAN01" TO CM1-ERRFILE
MOVE "PRTAN02" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
MOVE IND-OFF TO IN12 OF MSELEZ-I-INDIC.
MOVE SPACES TO CM1-MSG MMSG OF MSELEZ-O W-STRINGA.
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL IN12 OF MSELEZ-I-INDIC = IND-ON.
FINE.
CLOSE MRTAN01.
GOBACK.
SEQUENZA.
CLOSE MRTAN01.
OPEN I-O MRTAN01.
MOVE 0 TO CONT
PERFORM RICERCA THRU EX-RICERCA
VARYING INDEX1 FROM 38 BY -1
UNTIL INDEX1 < 1 OR ALFA(INDEX1) NOT EQUAL TO SPACE
PERFORM SCRIVI THRU EX-SCRIVI
INITIALIZE CM1-MATRICOLA CM1-D10PER CM1-PROPER WMPERI.
MOVE 0 TO WEMPERI WEMDA WEMA.
MOVE IND-OFF TO IN12 OF MSELEZ-I-INDIC.
IF MSEGNO1 OF MSELEZ-O = LOW-VALUE OR SPACES
MOVE "+" TO MSEGNO1 OF MSELEZ-O.
IF MSEGNO2 OF MSELEZ-O = LOW-VALUE OR SPACES
MOVE "+" TO MSEGNO2 OF MSELEZ-O.
MOVE "N" TO MGUIDA1 OF MSELEZ-O.
MOVE 0 TO MGUIDA2 OF MSELEZ-O.
MOVE "STAMPA PER INTERRUZIONE PRESCRIZIONE" TO MTIT
MOVE 0 TO CM1-MATRICOLA CM1-D10PER WD10PER
WRITE REC-VIDEO FORMAT "MSELEZ".
READ MRTAN01 FORMAT "MSELEZ"
INDICATORS ARE AREA-INDIC.
IF IN12 OF MSELEZ-I-INDIC = IND-ON
MOVE SPACES TO CM1-MSG
GO TO EX-SEQUENZA
END-IF.
MOVE SPACES TO MMSG OF MSELEZ-O.
IF MMATR OF MSELEZ-I IS NUMERIC
MOVE MMATR OF MSELEZ-I TO CM1-MATRICOLA
END-IF.
IF MMESEDA OF MSELEZ-I IS NUMERIC AND MANNODA OF MSELEZ-I
IS NUMERIC
MOVE MMESEDA OF MSELEZ-I TO WMMESE
MOVE MANNODA OF MSELEZ-I TO WMANNO
MOVE WMPERI TO CM1-D10PER
END-IF.
IF MMESEA OF MSELEZ-I IS NUMERIC AND MANNOA OF MSELEZ-I
IS NUMERIC
MOVE MMESEA OF MSELEZ-I TO WMMESE
MOVE MANNOA OF MSELEZ-I TO WMANNO
MOVE WMPERI TO WD10PER
END-IF.
IF WD10PER < CM1-D10PER AND WD10PER > 0
MOVE "RICHIESTA PRIVA DI LOGICA !" TO W-STRINGA
GO TO EX-SEQUENZA
END-IF.
IF MEMDA1 OF MSELEZ-I IS NUMERIC AND MEMDA2 OF MSELEZ-I
IS NUMERIC
MOVE MEMDA1 OF MSELEZ-I TO WEMMM
MOVE MEMDA2 OF MSELEZ-I TO WEMAA
MOVE 01 TO WEMGG
MOVE WEMPERI TO WEMDA
END-IF.
IF MEMA1 OF MSELEZ-I IS NUMERIC AND MEMA2 OF MSELEZ-I
IS NUMERIC
MOVE MEMA1 OF MSELEZ-I TO WEMMM
MOVE MEMA2 OF MSELEZ-I TO WEMAA
MOVE 31 TO WEMGG
MOVE WEMPERI TO WEMA
END-IF.
IF WEMA < WEMDA AND WEMA > 0
MOVE "RICHIESTA PRIVA DI LOGICA !" TO W-STRINGA
GO TO EX-SEQUENZA
END-IF.
IF MIMPDA OF MSELEZ-I IS NUMERIC
MOVE MIMPDA OF MSELEZ-I TO WIMPDA
IF MSEGNO1 OF MSELEZ-I IS = '-'
COMPUTE WIMPDA = WIMPDA * -1
END-IF
ELSE
MOVE -999999999 TO WIMPDA
END-IF.
IF MIMPA OF MSELEZ-I IS NUMERIC
MOVE MIMPA OF MSELEZ-I TO WIMPA
IF MSEGNO2 OF MSELEZ-I IS = '-'
COMPUTE WIMPA = WIMPA * -1
END-IF
ELSE
MOVE 999999999 TO WIMPA
END-IF.
IF WIMPDA < WIMPDA
MOVE SPACES TO W-STRINGA
MOVE "RICHIESTA PRIVA DI LOGICA !" TO W-STRINGA
GO TO EX-SEQUENZA
END-IF.
MOVE MGUIDA1 OF MSELEZ-I TO WPASS.
MOVE MGUIDA2 OF MSELEZ-I TO WGUIDA.
IF CM1-MATRICOLA = 0 AND WIMPDA = -999999999 AND
WIMPA = 999999999 AND WPASS = "N"
AND CM1-D10PER = 0 AND WD10PER = 0
AND WEMDA = 0 AND WEMA = 0
MOVE SPACES TO W-STRINGA
MOVE "SCEGLI ALMENO UN CRITERIO !" TO W-STRINGA
GO TO EX-SEQUENZA
END-IF.
CALL "PRTAN03" USING AREA-MN01 AREA-COMUNE
MOVE CM1-MSG TO W-STRINGA.
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 MMSG OF MSELEZ-O
WITH POINTER CONT2.
EX-SCRIVI. EXIT.
