* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                             *
      * 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.
      *************************************************************
          

Top