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