* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* Ordinamento (SORT) di un archivio INDEXED *
* e creazione di un archivio LINE SEQUENTIAL ordinato *
* sulla base delle chiavi fornite *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. PROG-3.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
CONSOLE IS CRT
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
* al nome interno ANAGRAFICA-MAG associo l'identificatore FILE-1
* a cui sarà assegnato il nome del file su disco
*
* la chiave di accesso e' articolo
* la chiave alternativa e' articolo-fornit
*
SELECT ANAGRAFICA-MAG ASSIGN TO FILE-1
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS ARTICOLO
ALTERNATE RECORD KEY IS ARTICOLO-FORNIT
WITH DUPLICATES
LOCK MODE IS AUTOMATIC
STATUS MAG-STAT.
*
* al nome interno SORTED-MAG associo l'identificatore FILE-2
* a cui sarà assegnato il nome del file su disco
*
SELECT SORTED-MAG ASSIGN TO FILE-2
ORGANIZATION IS LINE SEQUENTIAL
ACCESS IS SEQUENTIAL
LOCK MODE IS AUTOMATIC
STATUS SOR-STAT.
*
* al nome interno SORT-AREA associo l'identificatore FILE-3
* a cui sarà assegnato il nome del file su disco
*
* l'area di SORT provvede a creare un file temporaneo per
* le operazioni di ordinamento
*
SELECT SORT-AREA ASSIGN TO FILE-3.
DATA DIVISION.
FILE SECTION.
*
* descrizione della struttura dei records di ANAGRAFICA-MAG
*
FD ANAGRAFICA-MAG.
01 REC-MAG.
02 ARTICOLO PIC X(16).
02 ARTICOLO-FORNIT PIC X(16).
02 DESCRIZIONE PIC X(30).
02 UNITA-MISURA PIC XX.
02 GRUPPO-MERC PIC S9(3) COMP-3.
02 CODICE-IVA PIC 99.
02 SCORTA-MIN PIC S9(7) COMP-3.
02 COSTO-ULTIMO PIC S9(6)V99 COMP-3.
02 COSTO-MEDIO PIC S9(6)V99 COMP-3.
02 PREZZO-VEND PIC S9(6)V99 COMP-3 OCCURS 4.
02 ESISTENZA PIC S9(7)V99 COMP-3.
02 ORDINATO PIC S9(7)V99 COMP-3.
02 IMPEGNATO PIC S9(7)V99 COMP-3.
02 CONFEZIONE PIC 99.
02 CODICE-FORNIT PIC 9999.
02 PROG-CARICO PIC S9(7)V99 COMP-3 OCCURS 4.
02 PROG-SCARICO PIC S9(7)V99 COMP-3 OCCURS 4.
02 COSTO-VENDUTO PIC S9(7)V99 COMP-3.
02 FATTUR-NETTO PIC S9(7)V99 COMP-3.
02 ULTIMO-CARICO PIC 9(8) COMP-3.
02 ULTIMO-SCARICO PIC 9(8) COMP-3.
02 CARICO-ANNUO PIC S9(7)V99 COMP-3.
02 ESIST-INIZ PIC S9(7)V99 COMP-3.
02 ESIST-FINALE PIC S9(7)V99 COMP-3.
02 FILLER PIC X(22).
*
*
* descrizione della struttura dei records di SORTED-MAG
* la struttura è la stessa di ANAGRAFICA-MAG
* ed usiamo una descrizione dei campi simile ma NON UGUALE
*
FD SORTED-MAG.
01 REC-MAG-2.
02 ARTICOLO-2 PIC X(16).
02 ARTICOLO-FORNIT-2 PIC X(16).
02 DESCRIZIONE-2 PIC X(30).
02 UNITA-MISURA-2 PIC XX.
02 GRUPPO-MERC-2 PIC S9(3) COMP-3.
02 CODICE-IVA-2 PIC 99.
02 SCORTA-MIN-2 PIC S9(7) COMP-3.
02 COSTO-ULTIMO-2 PIC S9(6)V99 COMP-3.
02 COSTO-MEDIO-2 PIC S9(6)V99 COMP-3.
02 PREZZO-VEND-2 PIC S9(6)V99 COMP-3 OCCURS 4.
02 ESISTENZA-2 PIC S9(7)V99 COMP-3.
02 ORDINATO-2 PIC S9(7)V99 COMP-3.
02 IMPEGNATO-2 PIC S9(7)V99 COMP-3.
02 CONFEZIONE-2 PIC 99.
02 CODICE-FORNIT-2 PIC 9999.
02 PROG-CARICO-2 PIC S9(7)V99 COMP-3 OCCURS 4.
02 PROG-SCARICO-2 PIC S9(7)V99 COMP-3 OCCURS 4.
02 COSTO-VENDUTO-2 PIC S9(7)V99 COMP-3.
02 FATTUR-NETTO-2 PIC S9(7)V99 COMP-3.
02 ULTIMO-CARICO-2 PIC 9(8) COMP-3.
02 ULTIMO-SCARICO-2 PIC 9(8) COMP-3.
02 CARICO-ANNUO-2 PIC S9(7)V99 COMP-3.
02 ESIST-INIZ-2 PIC S9(7)V99 COMP-3.
02 ESIST-FINALE-2 PIC S9(7)V99 COMP-3.
02 FILLER PIC X(22).
*
*
* descrizione della struttura dei records di SORT-AREA
* la struttura è la stessa di ANAGRAFICA-MAG
* ed usiamo una descrizione dei campi simile ma NON UGUALE
*
SD SORT-AREA.
01 REC-MAG-S.
02 ARTICOLO-S PIC X(16).
02 ARTICOLO-FORNIT-S PIC X(16).
02 DESCRIZIONE-S PIC X(30).
02 UNITA-MISURA-S PIC XX.
02 GRUPPO-MERC-S PIC S9(3) COMP-3.
02 CODICE-IVA-S PIC 99.
02 SCORTA-MIN-S PIC S9(7) COMP-3.
02 COSTO-ULTIMO-S PIC S9(6)V99 COMP-3.
02 COSTO-MEDIO-S PIC S9(6)V99 COMP-3.
02 PREZZO-VEND-S PIC S9(6)V99 COMP-3 OCCURS 4.
02 ESISTENZA-S PIC S9(7)V99 COMP-3.
02 ORDINATO-S PIC S9(7)V99 COMP-3.
02 IMPEGNATO-S PIC S9(7)V99 COMP-3.
02 CONFEZIONE-S PIC 99.
02 CODICE-FORNIT-S PIC 9999.
02 PROG-CARICO-S PIC S9(7)V99 COMP-3 OCCURS 4.
02 PROG-SCARICO-S PIC S9(7)V99 COMP-3 OCCURS 4.
02 COSTO-VENDUTO-S PIC S9(7)V99 COMP-3.
02 FATTUR-NETTO-S PIC S9(7)V99 COMP-3.
02 ULTIMO-CARICO-S PIC 9(8) COMP-3.
02 ULTIMO-SCARICO-S PIC 9(8) COMP-3.
02 CARICO-ANNUO-S PIC S9(7)V99 COMP-3.
02 ESIST-INIZ-S PIC S9(7)V99 COMP-3.
02 ESIST-FINALE-S PIC S9(7)V99 COMP-3.
02 FILLER PIC X(22).
*
WORKING-STORAGE SECTION.
*
* campi per la gestione FILE-STATUS
*
01 MAG-STAT PIC XX.
01 SOR-STAT PIC XX.
01 VIDEO-1.
02 VIDEO-2 PIC X(12).
01 INDICE PIC 99.
01 FILE-STAT.
02 S1 PIC X.
02 S2 PIC X.
01 STAT-BIN REDEFINES FILE-STAT PIC 9(4) COMP.
01 DISPLAY-STAT.
02 S1-VID PIC X.
02 FILLER PIC X(3).
02 S2-VID PIC 9(4).
*
* campi contenenti i nomi dei file correnti
* la tabella viene ridefinita per indicizzare
* la posizione del nome-file
*
01 TAB-FILE.
02 FILE-01 PIC X(12) VALUE "MAGAZZ.IT ".
02 FILE-02 PIC X(12) VALUE "MAGSORT.LSQ ".
02 FILE-03 PIC X(12) VALUE "AREASORT ".
02 FILE-04 PIC X(12) VALUE " ".
02 FILE-05 PIC X(12) VALUE " ".
01 TAB-FIL REDEFINES TAB-FILE.
02 FIL PIC X(12) OCCURS 5.
*
01 IN-KEY PIC X.
PROCEDURE DIVISION.
INIZIO.
MOVE FILE-01 TO FILE-1.
MOVE FILE-02 TO FILE-2.
MOVE FILE-03 TO FILE-3.
PERFORM SET-COLOR THRU TITOLO.
APERTURA-FILE.
OPEN INPUT ANAGRAFICA-MAG.
MOVE MAG-STAT TO FILE-STAT.
IF S1 NOT = ZERO
MOVE 1 TO INDICE
PERFORM STATUS-TEST THRU EX-STATUS-TEST.
OPEN OUTPUT SORTED-MAG.
MOVE SOR-STAT TO FILE-STAT.
IF S1 NOT = ZERO
MOVE 2 TO INDICE
PERFORM STATUS-TEST THRU EX-STATUS-TEST.
*
* eseguiremo l'ordinamento dell'archivio sulla base dei
* seguenti criteri:
* ordine crescente di categoria merceologica
* ordine crescente di codice articolo
* ordine descrescente di ultimo prezzo di acquisto
*
ORDINAMENTO.
SORT SORT-AREA ON ASCENDING KEY GRUPPO-MERC-S ARTICOLO-S
ON DESCENDING KEY COSTO-ULTIMO-S
INPUT PROCEDURE LEGGI THRU LETTO
OUTPUT PROCEDURE SCRIVI THRU SCRITTO.
CHIUSURA-FILE.
CLOSE ANAGRAFICA-MAG.
CLOSE SORTED-MAG.
FINE-PROG.
DISPLAY SPACE.
STOP RUN.
* * * * Routines * * *
*
* estrazione dei records in base ai criteri forniti
*
LEGGI.
READ ANAGRAFICA-MAG NEXT AT END GO TO LETTO.
RELEASE REC-MAG-S FROM REC-MAG.
GO TO LEGGI.
LETTO.
EXIT.
*
* scrittura del nuovo file ordinato
*
SCRIVI.
RETURN SORT-AREA INTO REC-MAG-2 AT END GO TO SCRITTO.
WRITE REC-MAG-2.
GO TO SCRIVI.
SCRITTO.
EXIT.
* pulisce il video e setta il colore del testo e del fondo
*
SET-COLOR.
DISPLAY SPACE WITH BACKGROUND-COLOR 7
FOREGROUND-COLOR 8.
TITOLO.
DISPLAY " S O R T D I U N F I L E I N D E X E D "
AT 0117 WITH FOREGROUND-COLOR 9
BACKGROUND-COLOR 7
REVERSE-VIDEO.
*
* * * * inizio STATUS-TEST * * *
*
STATUS-TEST.
MOVE FIL(INDICE) TO VIDEO-1.
DISPLAY "Errore sul File" AT 2303 WITH FOREGROUND-COLOR 4.
DISPLAY VIDEO-2 AT 2319 WITH FOREGROUND-COLOR 2.
IF S1 = 1
DISPLAY "Fine File"
AT 2334 WITH FOREGROUND-COLOR 4
GO TO EX-STAT.
IF S1 = 2
DISPLAY "Chiave del record non valida"
AT 2334 WITH FOREGROUND-COLOR 4
GO TO EX-STAT.
IF S1 = 9
PERFORM TROVA-ERRORE THRU FINE-ERRORE.
MOVE S1 TO S1-VID.
MOVE LOW-VALUES TO S1.
MOVE STAT-BIN TO S2-VID.
DISPLAY "Tipo" AT 2403 WITH FOREGROUND-COLOR 4.
DISPLAY S2-VID AT 2408 WITH FOREGROUND-COLOR 4.
EX-STAT.
DISPLAY "Premi un tasto per continuare " AT 2436.
ACCEPT IN-KEY WITH AUTO-SKIP.
STOP RUN.
EX-STATUS-TEST.
EXIT.
*
* * * * fine STATUS-TEST * * *
*
TROVA-ERRORE.
MOVE LOW-VALUES TO S1.
MOVE STAT-BIN TO S2-VID.
IF S2-VID = 13
DISPLAY "File inesistente"
AT 2413 WITH FOREGROUND-COLOR 4.
IF S2-VID = 65
DISPLAY "File non disponibile"
AT 2413 WITH FOREGROUND-COLOR 4.
IF S2-VID = 68
DISPLAY "Record non disponibile"
AT 2413 WITH FOREGROUND-COLOR 4.
FINE-ERRORE.
EXIT.
*************************************************************
|
ritorna alla pagina precedente