* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* Creazione di un archivio RELATIVE *
* con preallocazione dei records *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. PROG-4a.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
CONSOLE IS CRT
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
* al nome interno ANAGRAFICA-CLI associo l'identificatore FILE-1
* a cui sarà assegnato il nome del file su disco
*
SELECT ANAGRAFICA-CLI ASSIGN TO FILE-1
ORGANIZATION IS RELATIVE
ACCESS IS DYNAMIC
RELATIVE KEY CLI-KEY
LOCK MODE IS AUTOMATIC
STATUS CLI-STAT.
DATA DIVISION.
FILE SECTION.
* descrizione della struttura dei records di ANAGRAFICA-CLI
*
FD ANAGRAFICA-CLI.
01 REC-CLI.
02 CODICE-CLI PIC 9999.
02 RAG-SOC PIC X(40).
02 INDIRIZZO PIC X(30).
02 LOCALITA PIC X(23).
02 CAP PIC 99999.
02 PROV PIC XX.
02 COD-FIS PIC X(16).
02 COD-IVA PIC X(11).
02 AGENTE PIC 99.
02 COD-TRASP PIC 9999.
02 PORTO PIC 9.
02 IMBALLO PIC 9.
02 DESTINATARIO PIC 9999.
02 PAGAMENTO PIC 99.
02 BANCA PIC 9999.
02 ESENZIONE PIC 99.
02 SCONTO PIC 99.
02 IVA PIC 99.
02 DATUL PIC X(6).
02 DATUL2 REDEFINES DATUL.
03 MML PIC XX.
03 AAL PIC XXXX.
02 SPESE PIC XX.
02 TIP PIC X.
02 ZONA PIC X.
02 FATTURATO PIC 9(8)V99.
02 LISTPREZ PIC 9.
02 TELEFONO OCCURS 4.
03 TELE PIC X(14).
02 FATTURAZIONE PIC X.
02 DATA-DECORR PIC X(8).
02 DATA-DECORR2 REDEFINES DATA-DECORR PIC 9(8).
02 FILLER PIC X(24).
*
WORKING-STORAGE SECTION.
*
* campi per la gestione FILE-STATUS
*
01 CLI-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 "CLIENTI.REL ".
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 CONTA PIC 999.
01 SPAZIO PIC X(80) VALUE SPACE.
*
* chiave del file ANAGRAFICA-CLI
*
01 CLI-KEY PIC 9(04).
PROCEDURE DIVISION.
INIZIO.
MOVE FILE-01 TO FILE-1.
PERFORM SET-COLOR THRU TITOLO.
APERTURA-FILE.
OPEN I-O ANAGRAFICA-CLI.
MOVE CLI-STAT TO FILE-STAT.
IF S1 NOT = ZERO
MOVE 1 TO INDICE
PERFORM STATUS-TEST THRU EX-STATUS-TEST.
*
* la START seguente ci consente di verificare se il file è stato
* in precedenza inizializzato, in caso contrario si avvia
* la preallocazione dei records
*
START ANAGRAFICA-CLI KEY NOT < CLI-KEY INVALID
PERFORM ALLOCA THRU ALLOCATI.
*
* visualizzazione della descrizione dei campi di input
*
MASCHERA.
DISPLAY "cliente" AT 0202.
DISPLAY "...." AT 0220 WITH FOREGROUND-COLOR 1.
DISPLAY "codice fiscale" AT 0302.
DISPLAY "................" AT 0320 WITH FOREGROUND-COLOR 1.
DISPLAY "partita iva" AT 0402.
DISPLAY "..........." AT 0420 WITH FOREGROUND-COLOR 1.
DISPLAY "rag.sociale" AT 0502.
DISPLAY "........................................" AT 0520
WITH FOREGROUND-COLOR 1.
DISPLAY "indirizzo" AT 0602.
DISPLAY ".............................." AT 0620
WITH FOREGROUND-COLOR 1.
DISPLAY "cap loc. prov." AT 0702.
DISPLAY "....." AT 0720 WITH FOREGROUND-COLOR 1.
DISPLAY "......................." AT 0726
WITH FOREGROUND-COLOR 1.
DISPLAY ".." AT 0750 WITH FOREGROUND-COLOR 1.
DISPLAY "Telef.1" AT 0758.
DISPLAY ".............." AT 0766 WITH FOREGROUND-COLOR 1.
DISPLAY "Telef.2" AT 0858.
DISPLAY ".............." AT 0866 WITH FOREGROUND-COLOR 1.
DISPLAY "Cellul." AT 0958.
DISPLAY ".............." AT 0966 WITH FOREGROUND-COLOR 1.
DISPLAY "Fax " AT 1058.
DISPLAY ".............." AT 1066 WITH FOREGROUND-COLOR 1.
DISPLAY "agente" AT 0802.
DISPLAY ".." AT 0820 WITH FOREGROUND-COLOR 1.
DISPLAY "............... " AT 0826 WITH FOREGROUND-COLOR 1.
DISPLAY "vettore" AT 0902.
DISPLAY "...." AT 0920 WITH FOREGROUND-COLOR 1.
DISPLAY ".........................." AT 0926
WITH FOREGROUND-COLOR 1.
DISPLAY "porto" AT 1002.
DISPLAY "." AT 1020 WITH FOREGROUND-COLOR 1.
DISPLAY "..............." AT 1026 WITH FOREGROUND-COLOR 1.
DISPLAY "imballo" AT 1102.
DISPLAY "." AT 1120 WITH FOREGROUND-COLOR 1.
DISPLAY "............... " AT 1126 WITH FOREGROUND-COLOR 1.
DISPLAY "destinatario" AT 1202.
DISPLAY "...." AT 1220 WITH FOREGROUND-COLOR 1.
DISPLAY ".............................." AT 1226
WITH FOREGROUND-COLOR 1.
DISPLAY "pagamento" AT 1302.
DISPLAY ".." AT 1320 WITH FOREGROUND-COLOR 1.
DISPLAY "..................................." AT 1326
WITH FOREGROUND-COLOR 1.
DISPLAY "banca" AT 1402.
DISPLAY "...." AT 1420 WITH FOREGROUND-COLOR 1.
DISPLAY "..................................." AT 1426
WITH FOREGROUND-COLOR 1.
DISPLAY "esenzione" AT 1502.
DISPLAY ".." AT 1520 WITH FOREGROUND-COLOR 1.
DISPLAY "...................." AT 1526
WITH FOREGROUND-COLOR 1.
DISPLAY "i.v.a. fissa" AT 1602.
DISPLAY ".." AT 1620 WITH FOREGROUND-COLOR 1.
DISPLAY "cod. sconto " AT 1702.
DISPLAY "sconto cassa" AT 1728.
DISPLAY "listino (1-4)" AT 1746.
DISPLAY ".." AT 1720 WITH FOREGROUND-COLOR 1.
DISPLAY ".." AT 1742 WITH FOREGROUND-COLOR 1.
DISPLAY "." AT 1760 WITH FOREGROUND-COLOR 1.
DISPLAY "tipo cliente zona" AT 1802.
DISPLAY "." AT 1820 WITH FOREGROUND-COLOR 1.
DISPLAY "." AT 1843 WITH FOREGROUND-COLOR 1.
DISPLAY "decorrenza pagamento" AT 1846.
DISPLAY "../../...." AT 1867 WITH FOREGROUND-COLOR 1.
DISPLAY "ultimo acquisto fatt." AT 1902.
DISPLAY "..-...." AT 1920 WITH FOREGROUND-COLOR 1.
DISPLAY "........,.." AT 1933 WITH FOREGROUND-COLOR 1.
DISPLAY "freq.fatturaz. (S/M)" AT 1946.
DISPLAY "." AT 1971 WITH FOREGROUND-COLOR 1.
*
* qui vanno messe le istruzioni per le operazioni
* da eseguire (inserimento/modifica/ricerca/stampa/ecc.)
*
*
* la seguente riga serve ad attendere la pressione di un tasto
* per avviare la chiusura del programma
*
ACCEPT IN-KEY WITH AUTO-SKIP.
CHIUSURA-FILE.
CLOSE ANAGRAFICA-CLI.
FINE-PROG.
DISPLAY SPACE.
STOP RUN.
* * * * Routines * * *
* routine di allocazione recors ANAGRAFICA-CLI
*
* ricerca punto da cui iniziare l'allocazione
*
ALLOCA.
MOVE 1 TO CLI-KEY.
START ANAGRAFICA-CLI KEY = CLI-KEY INVALID MOVE 0 TO CLI-KEY
GO TO INIZIA-DA-QUI.
DISPLAY "Posizionamento Puntatore records Clienti" AT 2121
WITH BLINK.
RILEGGI.
READ ANAGRAFICA-CLI NEXT AT END
MOVE CODICE-CLI TO CLI-KEY GO TO INIZIA-DA-QUI.
DISPLAY CLI-KEY AT 2348 WITH HIGHLIGHT.
GO TO RILEGGI.
*
* punto da cui inizia l'allocazione
*
INIZIA-DA-QUI.
DISPLAY "Allocazione di 100 nuovi records Clienti" AT 2121
WITH BLINK.
MOVE ZERO TO CONTA.
SCRIVI.
ADD 1 TO CLI-KEY.
ADD 1 TO CONTA.
MOVE SPACE TO REC-CLI.
MOVE CLI-KEY TO CODICE-CLI.
WRITE REC-CLI INVALID NEXT SENTENCE.
DISPLAY CONTA AT 2330 WITH FOREGROUND-COLOR 14.
DISPLAY CLI-KEY AT 2348 WITH FOREGROUND-COLOR 4.
IF CONTA < 100
GO TO SCRIVI.
DISPLAY " Allocazione completata - premi un tasto " AT 2120
WITH HIGHLIGHT.
ACCEPT IN-KEY WITH AUTO-SKIP.
DISPLAY SPAZIO AT 2101.
DISPLAY SPAZIO AT 2301.
ALLOCATI.
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 " C R E A Z I O N E D I U N F I L E R E L A T
- " I V E " AT 0110 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