* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* Creazione di un archivio INDEXED *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. PROG-2.
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.
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).
*
WORKING-STORAGE SECTION.
*
* campi per la gestione FILE-STATUS
*
01 MAG-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
*
* il compilatore Microfocus affianchera' al file MAGAZZ.IT
* il file MAGAZZ.IDX contenente le chiavi indicizzate
* altri compilatori ad es. Fujitsu manterranno le chiavi all'interno
* del file MAGAZZ.IT
*
01 TAB-FILE.
02 FILE-01 PIC X(12) VALUE "MAGAZZ.IT ".
02 FILE-02 PIC X(12) VALUE " ".
02 FILE-03 PIC X(12) VALUE " ".
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.
01 ARTICOLO-COM PIC X(16).
01 ART-COM1 REDEFINES ARTICOLO-COM.
02 TEST-ESC PIC X.
02 ART-COM2 PIC X(15).
01 VUOTO PIC X(16) VALUE SPACE.
78 ESC-KEY VALUE X"1B".
PROCEDURE DIVISION.
INIZIO.
MOVE FILE-01 TO FILE-1.
PERFORM SET-COLOR THRU TITOLO.
*
* se il file ancora non esiste il compilatore Microfocus ne crea
* uno nuovo con il comando OPEN I-O
* nel caso del compilatore Fujitsu per effettuare l'apertura in I-O
* e' necessario che il file esista, ed allora bisognera' testarne
* l'esistenza disasteriscando le seguenti righe:
*
*TEST-APERTURA-FUJITSU.
* OPEN I-O ANAGRAFICA-MAG.
* MOVE MAG-STAT TO FILE-STAT.
* MOVE LOW-VALUES TO S1.
* MOVE STAT-BIN TO S2-VID.
* IF S2-VID = 13
* CLOSE ANAGRAFICA-MAG
* OPEN OUTPUT ANAGRAFICA-MAG.
* CLOSE ANAGRAFICA-MAG.
*
APERTURA-FILE.
OPEN I-O ANAGRAFICA-MAG.
MOVE MAG-STAT TO FILE-STAT.
IF S1 NOT = ZERO
MOVE 1 TO INDICE
PERFORM STATUS-TEST THRU EX-STATUS-TEST.
CICLO-INPUT.
MOVE SPACE TO ARTICOLO-COM.
DISPLAY "Digitare Codice Articolo Fornit.: " AT 0602.
DISPLAY "Digitare Codice Articolo Interno: " AT 0502.
*
* viene richiamata una funzione interna per l'input di
* caratteri speciali, in questo caso si controlla se
* viene premuto il tasto ESC per terminare l'immissione
*
CALL X"83" USING TEST-ESC.
IF TEST-ESC = ESC-KEY GO TO CHIUSURA-FILE.
DISPLAY TEST-ESC AT 0537.
*
* se il tasto premuto e' diverso da ESC si prosegue con
* l'inserimento del resto del codice
*
ACCEPT ART-COM2 AT 0538.
*
* si controlla che il codice non esista
*
MOVE ARTICOLO-COM TO ARTICOLO.
READ ANAGRAFICA-MAG
NOT INVALID DISPLAY "Articolo già esistente - premere un
- " tasto " AT 2319
ACCEPT IN-KEY WITH AUTO-SKIP
DISPLAY SPACE AT 2301
GO TO CICLO-INPUT.
*
* si inserisce il codice articolo fornitore
*
ACCEPT ARTICOLO-FORNIT AT 0637.
WRITE REC-MAG
INVALID DISPLAY "Errore Registrazione" AT 2330
ACCEPT IN-KEY WITH AUTO-SKIP
DISPLAY SPACE AT 2301.
*
* si puliscono le aree dello schermo interessate
*
DISPLAY VUOTO AT 0537.
DISPLAY VUOTO AT 0637.
*
* qui vanno messe le istruzioni per le operazioni
* di input per gli altri campi
*
GO TO CICLO-INPUT.
CHIUSURA-FILE.
CLOSE ANAGRAFICA-MAG.
FINE-PROG.
DISPLAY SPACE.
STOP RUN.
* * * * Routines * * *
* 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 " C R E A Z I O N E D I U N F I L E I N D E X
- " E D " AT 0112 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.
*************************************************************