6. LISTING DES PROGRAMMES.

TABLEAU 1.
LISTE DES PRODUITS ET LEUR CODIFICATION.

Figure 3

Figure 4

Figure 5

<C> pour Chenger,
<F> pour Finir la saisie,
<RETOUR> pour Continuer,

Figure 1

Figure 2

TABLEAU 2.
LISTE ET CODIFICATION DES FIVONDRONANA A MADAGASCAR.

- 1 - ANTANANARIVO

- 103 - Antananarivo
- 104 - Ambatolampy
- 105 - Ambohidratrimo
- 106 - Andramasina
- 107 - Anjozorobe
- 108 - Ankazobe
- 109 - Antanifotsy
- 110 - Antsirabe
- 112 - Arivonimano
- 113 - Betafo
- 114 - Faratsiho
- 115 - Fenoarivo-Be
- 116 - Manjakandriana
- 117 - Miarinarivo
- 118 - Soavinandriana
- 119 - Tsiroanomandidy

- 2 - ANTSIRANANA

- 202 - Antsiranana
- 203 - Ambanja
- 204 - Ambilobe
- 205 - Andapa
- 206 - Antalaha
- 207 - Nosy-Be
- 208 - Sambava
- 209 - Vohemar

- 3 - FIANARANTSOA

- 302 - Fianarantsoa
- 303 - Ambalavao
- 304 - Ambatofinandrahana
- 305 - Ambohimahasoa
- 306 - Ambositra
- 307 - Befotaka
- 308 - Fandriana
- 309 - Farafangana
- 310 - Fort-Carnot
- 311 - Iakora
- 312 - Ifanadiana
- 313 - Ihosy
- 314 - Ikalamavony
- 315 - Ivohibe
- 316 - Manakara
- 317 - Mananjary
- 318 - Midonay du Sud
- 319 - Nosy Varika
- 320 - Vangaindrano
- 321 - Vohipono
- 322 - Vondrozo

- 4 - MAHAJANGA

- 402 - Mahajanga
- 403 - Ambato-Boeni
- 404 - Ambatomainty
- 405 - Analalava
- 406 - Antsalova
- 407 - Antsohihy
- 408 - Bealanana
- 409 - Befandriana-nord
- 410 - Besalampy
- 411 - Kandreho
- 412 - Maevatanana
- 413 - Maintirano
- 414 - Mampikony
- 415 - Mandritsara
- 416 - Marovoay
- 417 - Mitsinjo
- 418 - Morafenobe
- 419 - Port-Bergé
- 420 - Soalala
- 421 - Tsaratanana

- 5 - TOAMASINA

- 502 - Toamasina
- 503 - Ambatondrazaka
- 504 - Amparafaravola
- 505 - Andilamena
- 506 - Anosibe An'Ala
- 507 - Antanambaomanampotsy
- 508 - Brickaville
- 509 - Fénérivo Est
- 510 - Mahanoro
- 511 - Manenara Nord
- 512 - Maroantsotra
- 513 - Marolambo
- 514 - Moramanga
- 515 - Sainte flarie
- 516 - Soanierana Ivongo
- 517 - Vatomandry
- 518 - Vavalenina

- 6 - TOLIARY

- 602 - Toliary
- 603 - Amboasary Sud
- 604 - Ambovombe
- 605 - Ampanihy Ouest
- 606 - Ankazeabo Sud
- 607 - Bekily
- 608 - Belo/Tsiribihina
- 609 - Beloha
- 610 - Benenitra
- 611 - Berorcha
- 612 - Betioky Sud
- 613 - Betroka
- 614 - Tolagnaro
- 615 - Mahabo
- 616 - Manja
- 617 - Miandrivaze
- 618 - Morombe
- 619 - Morondava
- 620 - Sakaraha
- 621 - Tsihombe

- 7 - ETRANGER

- 702 - île de la Réunion
- 703 - île Maurice
- 704 - île Comores
- 705 - France
- 706 - Japon
- 707 - Rép. Féd. Allemagne
- 708 - Royaume Uni
- 709 - Italie
- 710 - U.S.A.
- 711 - Hong Kong
- 712 - U.R.S.S.
- 713 - Canada
- 714 - Seychelles
- 715 - Singapoure
- 716 - Belgique
- 717 - Mozambique
- 719 - Autres destinations

TABLEAU 3.
LISTE ET CODIFICATION DES MODE DE TRANSPORT.

- 00 - transport local, à pied
- 01 - Avion
- 02 - Bateau
- 03 - Colis postal
- 04 - Camion, route
- 05 - Train

START_COS COMMAND FILE

******************************************************************************************
Ce programme traite la saisie et la compilation des CERTIFICATS d'ORIGINE et de SALUBRITE (COS) émis par les différentes autorités des pêches dans les diverses provinces de Madagascar.
Ce programme d'initialisation débute par le présentation d'un menu à partir duquel différentes options sont disponibles à l'utilisateur. Des menus de second ordre sont disponibles à des niveaux inférieurs de la manipulation des données.

Le programme a été créer par Mr. M. BELLEMANS, Expert Statisticien FAO, dans le cadre du projet PNUD/FAO/MAG/85/014 - “Assistance à l'Administration des Peches et de l'Aquaculture”.

Date de création initiale: 01/10/1987
Version : Numéro - 1 - Date de révision : 24/12/1987
******************************************************************************************

* préparation de l'environement de travail

CLEAR ALL
SET BELL OFF
SET DEFAULT TO C
SET HEADING ON
* SET HELP OFF
SET PATH TO C:\DBASE\COS
SET CONFIRM ON
SET SAFETY ON
CLEAR
SET TALK OFF

* présentation du menu principal

STORE .T. TO Reply
DO WHILE Reply
   STORE SPACE(1) TO Action
   CLEAR
   @ 3,10 SAY "***MENU PRINCIPAL ***"
   @ 4,10 SAY "EXPEDITION DES PRODUITS HALIEUTIQUES"
   @ 5,10 SAY "CERTIFICATS D'GRIGINE ET DE SALUBRITE"
   @ 6,10 SAY "(C.O.S.)"
   @ 9,8 SAY "-1- AJOUTER des données aux fichiers"
   @ 10,8 SAY "-2- EDITER/LISTER les données d'un fichier"
   @ 11,8 SAY "-3- Expedition mensuelle (MENU)"
   @ 12,8 SAY "-4- Expedition TOTALE annuelle (MENU)"
   @ 14,8 SAY "-5- Préparer une nouvelle disquette"
   @ 15,8 SAY "-6- COPIE (sauvegarde) des fichiers"
   @ 16,8 SAY "-7- AJUSTEMENT des PRIX"
   @ 18,8 SAY "-X- QUITTER le programme"
   @ 20,8 SAY "Choisissez un nombre ( <X> pour TERMINER)" GET Action
   @ 2,8 TO 7,70 DOUBLE
   @ 8,8 TO 21,70
   READ

  IF UPPER(Action) ="X'
     CLEAR
     @ 10,20 SAY " Vous QUITTER le programme …"
     ?
     WAIT
     USE
     CLOSE DATABASES
     CLEAR ALL
     QUIT
  ELSE
     IF Action ="1'
        DO ADD COS
     ELSE
        IF Action ="2'
           CLEAR
        DISPLAY FILES ON A:
        ?
        ? ' Quel fichier voulez-vous REVOIR ?'
        ? " n'oubliez pas d'ajouter .DBF après le nom du fichier !"
        ?
        ACCEPT TO Database
        STORE UPPER (Database) TO Database
        IF FILE ('A:'+Database)
           USE A:& Database
           DO Review
        ELSE

* efface jusqu'à la fin de l'écran.

            @ 17,0 SAY CHR(27)+CHR(74)
            @ 17,10 SAY UPPER (Database)+" n'est pas dans la liste ?"
            @ 18,10 SAY "Controlez votre frappe, puis tapez <RETOUR>"
            WAIT
        ENDIF
     ELSE
        IF Action ="3'

* donne accès au menu de traitement des données.

           DO EXP MEN
        ELSE
           IF Action ="4'

* donne accès au menu de traitement total annuel.

           DO T_EXPE_0
        ELSE
           IF Action ="5'

* permet de créer une nouvelle diskette.

           DO MKFL
        ELSE
           IF Action ="6'

* permet de faire une copie de la diskette de données.

           DO COS COPIE
        ELSE
           IF Action ="7'

* permet de faire un ajustement des estimations des valeurs en remplacant
* les valeurs 0 par des valeurs plus réalistes.

                  DO AJU PRIX
                ENDIF 7
              ENDIF 6
            ENDIF 5
          ENDIF 4
        ENDIF 3
      ENDIF 2
    ENDIF 1
   ENDIF X
   STORE .T. TO Reply
ENDDO Reply

* fin du programme de traitement des C.O.S.

ADD (AJOUTER) COS COMMAND FILE

*********************************************************************************************
On se trouve ici un niveau plus bas que le menu d'ouverture.
Les séléctions présentées sont des rafinements liés à la manipulation de l'addition d'enrégistrements des Certificats d'Origine et de Salubrité.
Les bases de données en usage ont pour nom le Faritany d'origine. par exemple : COS_TOAM.DBF (8 caractères.DBF)

Les nouvelles données ne sont pas saisies directement dans le fichier de destination car cela conduit à des contaminations des données et à toutes sortes de problèmes pour corriger les erreurs. Les données sont par contre saisies sur un fichier intérimaire appelé A:TEMPFILE.DBF.
Dans ce fichier intérimaire, les données peuvent être revues, éditées et corrigées selon les besoins.
Ce n'est que lorsque les enrégistrements sont jugés corrects, qu'ils sont transférés au fichier de destination en utilisant l'option de MISE A JOUR du menu.

Ce Menu DOIT être excécuté de façon séquentielle (c.a.d. du premier numero au dernier) si l'on veut éviter des erreurs d'addition des nouvelles données !!!!. *********************************************************************************************

* Démarrage du sous programme et présentation d'un menu de second ordre tant
* que l'opérateur ne décidera pas de retourner au menu principal.

STORE .T. TO Temporaire
DO WHILE Temporaire
   CLEAR
   STORE SPACE(1) TO Act
   @ 3,15 SAY ' MENU - ADDITION DONNEES COS '
   @ 4,15 SAY ' --------------------------- '
   @ 6,15 SAY ' -1- ENTRER nouvelles données '
   @ 7,15 SAY ' -2- EDITER le fichier TEMPORAIRE '
   @ 8,15 SAY ' -3- REVOIR/IMPRIMER le fichier TEMPORAIRE '
   @ 9,15 SAY ' -4- MISE A JOUR du fichier de DESTINATION '
   @ 10,15 SAY ' -5- EFFACER données marquées du fichier TEMPORAIRE '
   @ 11,15 SAY ' … <RETOUR>… au menu précédent… ' GET Act
   @ 2,8 TO 12,70 DOUBLE
  READ
  CLEAR
  IF Act ="1'
* Saisie de nouvelles données.
     CLEAR
     @ 4,10 SAY 'VERIFIEZ tous les COS a out la saisie … !!!!'
     @ 6,10 SAY "VERIFIEZ qu'ils sont complets et corrects …!!!"
     @ 10,10 SAY 'Veulez-vous CONTINUER ? (O/N)'
     WAIT TO Goahead
     IF UPPER (Goahead) ="U'
        CLEAR
        STORE SPACE(1) TO Answ
*  Séléction du fichier auquel l'opérateur veut ajouter des données.
        @ 5,10 SAY 'Pour quel FARITANY voulez-vous AJOUTER des données ?'
        @ 7,10 SAY ' -1- ANTANANARIVO'
        @ 8,10 SAY ' -2- ANTSIRANANA'
        @ 9,10 SAY ' -3- FIANARANTSOA'
        @ 10,10 SAY ' -4- MAHAJANGA'
        @ 11,10 SAY ' -5- TOAMASINA'
        @ 12,10 SAY ' -6- TOLTARA'
        @ 14,10 SAY ' ...<RETOUR>... au menu précédent...' GET Answ
        @ 8,8 TO 16,67
        READ
     IF Answ ="1' .OR. Answ="2' .OR. Answ="3' .OR. Answ="4' .OR. Answ="5' .OR. Answ="6'
* branchement vers le sous programme d'addition de nouvelles données.
        DO ADD_2
     ELSE
        USE
        CLOSE ALL
        RELEASE ALL
        RETURN
     ENDIF
   ELSE
     USE
     CLOSE ALL
     RELEASE ALL
     RETURN
   ENDIF
ELSE
  IF Act ="2'
* Edition du fichier temporaire pour vérification des données saisies.
        STORE 'O' TO Edt
        DO WHILE UPPER(EDT) ="O'
        CLEAR
        USE A:TEMPFILE
        IF EOF ()
           ?" Il n'y a pas de données dans le fichier TEMPORAIRE…!!!"
           ?' …<RETOUR>… pour Continuer…'
           WAIT
           STORE 'N' TO Edt
        ELSE
           GOTO BOTTOM
           CLEAR
           @ 3,15 SAY ' EDITION des données du fichier TEMPORAIRE :'
           @ 5,10 SAY ' Il y a '+STR(RECNO(),5)+' entrées dans le fichier.'
           ACCEPT " Quelle entrée voulez-vous EDITER …?" TO Number
           IF VAL(Number) <= 0 .OR. VAL(Number) > RECNO()
              ?
              ?
              ?' fichier transgressé : voulez-vous continuer ? (O/N) '
              ?
              WAIT TO Edt
           ELSE
              EDIT &Number
           CLEAR
           ?
           ?' voulez-vous EDITER une autre entrée ? (O/N)'
           ?
           WAIT TO Edt
        ENDIF
     ENDIF
  ENDDO Edt
  USE
  CLOSE ALL
  RELEASE ALL
ELSE
  IF Act ="3'
* Permet de revoir le fichier temporaire et d'imprimer les données.
     USE A: TEMPFILE
     STORE 'O' TO Reviewing
     SET PRINT OFF
     DO WHILE UPPER(Reviewing) ="0'
        CLEAR
        COUNT FOR .NOT. DELETED() TO Any
        IF Any = 0
        ?" pas d'entrées temporaires dens le fichier temporaire."
        ?' …<RETOUR>… pour continuer…'
        ?
        WAIT
        STORE "N" TO Reviewing
     ELSE
        CLEAR
        ?' Il v a '- SIR(ANY.5)+' entrées temporaires.'
        ?" voulez-vous qu'elles soient IMPRIMEES ? (O/N)"
        ?
        WAIT TO Output
        IF UPPER(Output) ="O'
           SET PRINT ON
           ?? CHR(15)
        ENDIF
        SET TALK OFF
        STORE 'OFF' TO Condition
        STORE 'O' TO Number
        DO Printout
        ?
        CLEAR
        ?" Cela sont toutes les entrées temporaires."
        ?" Voulez-vous les revoir ? (O/N)"
        ?" pour voir les entrées marguees pour effacement."
        ?" choisissez l'option EDITER du menu"
        ?
        WAIT TO Reviewing
     ENDIF
  ENDDO Reviewing
  USE
  RELEASE ALL
ELSE
  IF Act ="4'
* Action de mise à jour du fichier temporaire sur la disquette contenant
*  également la base de données.
     DO COS-MISJOUR
  ELSE
     IF Act ="5'
* Destruction des données du fichier temporaire (une fois que celles-ci
*  aient été transférées sur la disquette de destination finale par l'option
*  précédente du menu.
        ?
  ?" Cette action DETRUIT TOUTES LES DONNEES dans le FICHIER TEMPORAIRE !!!!"
        ?
        ?' voulez-vous Continuer…(O/N) '
        ?
        WAIT TO Wipeout
        IF UPPER(Wipeout) ="0'
           CLEAR
           USE A:TEMPFILE
           PACK
        ENDIF
           USE
           RELEASE ALL
        ELSE
           USE
           RELEASE ALL
           RETURN
       ENDIF 5
      ENDIF 4
    ENDIF 3
   ENDIF 2
  ENDIF 1
  STORE .T. TO Temporaire
ENDDO Temporaire
*  fin du sous programme d'addition de données au fichier de destination.

ADD_2 COMMAND FILE

********************************************************************************************
Ce programme accepte des données de COS pour toutes les Provinces.

Un fichier temporaire appelé GETUATA est utilise pour la saisie primaire des données car l'opérateur peut décider de quitter la saisie sur une donnée incomplète, qui est alors marquée pour effacement ultérieur.
Lorsque les données sont finalement ajoutées (APPEND[ed]) au fichier TEMPORAIRE, ces entrées ne sont pas transférées. Chaque entrée doit au moins contenir les codes des Faritany, Fivondronana, Nature du produit et mode de conditionnement. Si ceux-ci ne sont pas fournis, l'entrée est marquée pour un effacement ultérieur. ********************************************************************************************

* préparation du sous-programme de saisie des nouvelles données.

CLEAR
@ 5,10 SAY ' *** SAISIE DE DONNEES pour'
DO CASE
   CASE Answ ="5'
        ?? ' TOAMASINA ***'
   CASE Answ ="3'
        ?? ' FIANARANTSOA ***'
   CASE Answ ="6'
        ?? ' TOLIARA ***'
   CASE Answ ="4'
        ?? ' MAHAJANGA ***'
   CASE Answ ="2'
        ?? ' ANTSIRANANA ***'
   CASE Answ ="1'
        ?? ' ANTANANARIVO ***'
   OTHERWISE
        RELEASE ALL
        RETURN
ENDCASE
* vérification de la correspondence entre le fichier de destination finale
* et le choix fait par l'opérateur.
IF(Answ="5' .AND..NOT.FILE('A:COS_TOAM.DBF')).OR.(Answ="3'.AND..NOT.FILE;
 ('A:COS-FIAN.DBF')).OR.(Answ="6'.AND..NOT.FILE('A:COS_TULE.DBF')).OR.(Answ="4';
   .AND..NOT.FILE('A:COS-MAHA.DBF'))
    @ 10,10 SAY " voulez-vous MELANGER vos BASES DE DONNEES ?"
    @ 15,10 SAY " …inserez la bonne disquette…"
    @ 20,10 SAY " …<RETOUR>… au menu."
    WAIT
    RELEASE ALL
    RETURN
ELSE
   IF (Answ="2'.AND..NOT.FILE('A:COS_ANTS.DBF')).OR.(Answ="1'.AND..NOT.FILE;
      ('A:COS-ANTA.DBF'))
      @ 10,10 SAY " voulez-vous MELANGER vos BASES DE DONNEES ?"
      @ 15,10 SAY " …insérez la bonne disquette…"
      @ 20,10 SAY " …<RETOUR>… au menu."
      WAIT
      RELEASE ALL
      RETURN
   ENDIF
ENDIF
* Copiage de la structure du fichier temporaire TEMFFILE vers le fichier
* GETDATA sur le disque dur.
CLEAR
SELECT 1
USE A:TEMPFILE ALIAS Temp
COPY STRUCTURE TO GETDATA
SELECT 2
USE GETDATA
* Addition de nouvelles donnees dans le fichier GETDATA et verification des
* informations entrées.
STORE '0' TO Time
DO WHILE UPPER (TIME) <> 'F'
   APPEND BLANK
   STORE STR(RECNO(),5) TO Number
   STORE .T. TO Enter
   DO WHILE Enter
      CLEAR
      @ 2,20 SAY "CERTIFICATS D'ORIGINE ET DE SALUBRITE"
      @ 3,35 SAY "C.O.S."
      @ 3,3 SAY "Numéro de la donnée : "-Number
      @ 6,14 SAY "Faritany :"
      @ 6,25 GET GETDATA->FARITANY PICTURE "NN"
      @ 6,49 SAY "Fivondronana :"
      @ 6,64 GET GETDATA->FIVONDRON PICTURE "NNN"
      @ 8,5 SAY "Nature du produit :"
      @ 8,25 GET GETDATA->NAT PROD PICTURE "NN"
      @ 8,40 SAY "Moyen de conservation : "
      @ 8,64 GET GETDATA->CONSERV PICTURE "NN"
      @ 10,12 SAY "Expediteur : "
      @ 10,25 GET GETDATA->EXPEDITEUR PICTURE "NNN"
      @ 10,49 SAY "Destinataire : "
      @ 10,64 GET GETDATA->DESTIN PICTURE "NNN"
      @ 12,14 SAY "Quantité : "
      @ 12,25 GET GETDATA->QUANTITE
      @ 12,48 SAY "Vaieur : "
      @ 12,58 GET GETDATA->VALEUR
      @ 14,4 SAY "Moyen de transport : "
      @ 14,25 GET GETDATA->TRANSPORT PICTURE "NN"
      @ 16,30 SAY "DATE : "
      @ 16,38 GET GETDATA->DATE
      @ 1,1 TO 4,76 DOUBLE
      @ 5,3 TO 17,74
      READ

      STORE ' ' TO Getting
* La séquence suivante de procédures IF permet de vérifier l'exactitude de
* certaines données saisies, puis donne à l'opérateur le choix de corriger
* les erreurs ou de terminer la procédure d'entrée de données.
     IF SUBSTR(EXPEDITEUR.1.1) =" ' .OR. SUBSTR(EXPEDITEUR,2,1) =" ';
        .OR. SUBSTR (EXPEDITEUR,3,1) =" '
        ? ' EXPEDITEUR doit avoir un CODE de TROIS LETTRES !'
        ? ' F si saisie est FINIE,'
        ACCEPT ' <RETOUR> pour Changer.' TO Getting
     ELSE
        IF SUBSTR (DESTIN,1,1) =" ' .GR. SUBSTR (DESTIN,2,1) =" ';
           .OR. SUBSTR(DESTIN,3,1) =" '
        ? "DESTINATAIRE doit avoir un CODE de TROIS LETTRES !"
        ? ' F si saisie est FINIE,'
        ACCEPT ' <RETOUR> pour changer.' TO Getting
     ELSE
        IF SUBSTR(NAT PROD,1,1) =" '.OR. SUBSTR(NAT PROD,2,1) =" '
           ? "NATURE PRODUIT doit avoir un CODE de DEUX LETTRES !"
           ? ' F si saisie est FINIE,'
           ACCEPT ' <RETOUR> pour changer.' TO Getting
        ELSE
           IF SUBSTR(CONSERV,1,1) =" ' .OR. SUBSTR(CONSERV,2,1) =" '
              ? "CONSERVATION doit avoir un CODE de DEUX LETTRES !"
              ? 'F si saisie est FINIE,'
              ACCEPT ' <RETOUR> pour changer.'  TO Getting
           ELSE
* remise des lignes suivantes vers la marge !
IF SUBSTR(FIVONDRON,1,1) =" ' .OR.;
   SUBSTR(FIVONDRON,2,1) =" ' .OR. SUBSTR(FIVONDRON,3,1) =" '
   ? "FIVONDRONANA doit avoir un CODE de TROIS LETTRES !"
   ? ' F si saisie est FINIE,'
   ACCEPT ' <RETOUR> pour changer. ' TO Getting
ELSE
   IF SUBSTR(FARITANY,1,1) =" ' .OR. SUBSTR(FARITANY,2,1) =" '
      ? "FARITANY doit avoir un CODE de DEUX LETTRES !"
      ? ' F si saisie est FINIE,'
      ACCEPT '<RETOUR> pour Changer.' TO Getting
  ELSE
     IF SUBSTR(TRANSPORT,1,1) =" ' .OR. SUBSTR (TRANSPORT,2,1) =" '
        ? "MOYEN DE TRANSPORT doit avoir un CODE de DEUX LETTRES !"
        ? ' F si saisie est FINIE,'
        ACCEPT '<RETOUR> pour Changer.' TO Getting
     ELSE
        @ 18,10 SAY ' <C> pour Changer,'
        @ 19,10 SAY ' <F> pour Finir la saisie,'
        ACCEPT ' <RETOUR> pour Continuer.' TO Time

       IF UPPER (Time) ="C'
          STORE .T. TO Enter
       ELSE
          STORE .F. TO Enter
       ENDIF
   ENDIF Transport
ENDIF Faritany
* remise des lignes suivantes vers leur position d'origine.
                 ENDIF Fivondronana
              ENDIF Conservation
           ENDIF Nature produit
        ENDIF destinataire
   ENDIF expediteur
* Si l'opérateur décide de quitter sur une entrée incompléte, elle est
* marquée pour effacement de sorte qu'elle n'est pas transférée sur le fichier
* TEMPFILE.
   IF UPPER(Getting) ="F'
      DELETE RECORD &Number
      STORE .F. TO Enter
      STORE 'F' TO Time
      ENDIF
   ENDDO Enter
ENDDO Time
* vérification si il y a lieu de transférer des nouvelles données du
* fichier GETDATA vers le fichier TEMPFILE.
COUNT FOR .NOT. DELETED<> TO Any
IF Any = 0
   CLEAR
   ? "pas d'entrées à AJOUTER au FICHIER TEMPORAIRE…!"
   ? '… <RETOUR> … au menu.'
   USE
   WAIT
ELSE
   PACK
* Vérifie les codes dans la liste des codes pour trouver des irrégularités.
   DO CODE TEST
* Transfert des données du fichier GETDATA vers le fichier TEMPFILE.
   CLEAR
   @ 3,8 SAY ' **** NE ** PAS ** INTERROMPRE ****'
   @ 8,3 SAY '**** MISE ** A ** JOUR ** DU ** FICHIER ** TEMPORAIRE ****'
   USE
   SELECT 1 &&TEMPFILE
   APPEND FROM GETDATA
ENDIF *if Any
USE
CLOSE DATA BASES
* Destruction du fichier GETDATA aprés transfert des données vers le
* fichier TEMPFILE.
DELETE FILE C:GETDATA.DBF
RELEASE ALL
RETURN
* Retour au menu précédent qui a appelé ce sous-programme.

CODE-TEST COMMAND FILE

************************************************************************************************
Ce programme vérifie les codes pour les FARITANY, les FIVONDRONANA, la NATURE des PRODUITS et les MOYENS de CONSERVATION des données saisies en utilisant un fichier GLOBAL.DBF ou tous les codes ont été préalablement insérés.
Il donne à l'opérateur le choix d'EDITER (= corriger) ou d'ingnorer les observations faites par le programme.
************************************************************************************************

* mise en route du sous-programme de vérification des codes des données saisies.

SET TALK OFF

* vérification des codes des FARITANY.
GO TOP
DO WHILE .NOT. EOF()
   STORE STR(RECNO(),5) TO Number
   STORE UPPER(Faritany) TO Faritany
   CLEAR
   @ 4,15 SAY "***** VERIFICATION DES CODES Faritany *****"
   @ 6,15 SAY "Enrégistrement" +Number
   @ 7,15 SAY "Faritany :"+FARITANY
   STORE SUBSTR(Faritany,1,2) TO Key
   SELECT 3
   USE C:GLOBAL INDEX C:G-FA-DX
   FIND &Key
   STORE .T. TO Again
   STORE 'T' TO Decision
   IF (EOF() .OR. BOF())
      DO WHILE Again
         @ 9,10 SAY " Ce FARITANY n'est pas dans le fichier de référence  ."
         @ 11,10 SAY "  E pour l'EDITER."
         @ 12,10 SAY "  C pour CONTINUER (ignorer)."
         ?
         WAIT TO Decision
         IF UPPER(Decision) ="E'
            SELECT 2 &&Get
            EDIT &Number &&FIELDS FARITANY
            REPLACE Faritany WITH UPPER(Faritany)
            SELECT 3 &&Global
            STORE .F. TO Again
         ELSE
            IF UPPER(Decision) ="C'
               STORE .F. TO Again
            ELSE
               STORE .T. TO Again
            ENDIF C
         ENDIF &&'E'
      ENDDO Again
   ENDIF &&EOF() or BOF()
   SELECT 2 &&Get
   IF UPPER(Decision) <> 'E'
    * IF EOF ()
    *    GO TOP
    * ELSE
         SKIP
    * ENDIF
    ENDIF &&<>'E'
ENDDO Faritany

* Vérification des codes des FIVONDRONANA.
SELECT 2 &&Get
USE GETDATA
GO TOP
DO WHILE .NOT. EOF()
   STORE STR(RECNO(),5) to Number
   STORE UPPER(FIVONDRON) TO FIVONDRON
   CLEAR
   @ 4,15 SAY "*** VERIFICATION DES CODES Fivondronana ***"
   @ 6,15 SAY "Enrégistrement "+Number
   @ 7,15 SAY "Fivondronane :"+FIVONDRON
   STORE SUBSTR(FIVONDRON,1,3) TO Key
   SELECT 3 &&Global
   USE C:GLOBAL INDEX C:G-FI-DX
   FIND &Key
   STORE .T. TO Again
   STORE 'T' TO Decision
   IF (EOF() .OR. BOF()
      DO WHILE Again
   @ 9,!10 SAY "  Ce FIVONDRONANA n'est pas dans le fichier de référence !"
   @ 11,10 SAY "  E pour l'EDITER,"
   @ 12,10 SAY "  C pour CONTINUER (Ignorer)."
   ?
   WAIT TO Decision
   IF UPPER(Decision) ="E'
      SELECT 2 &&Get
      EDIT &Number &&FIELDS FIVONDRON
      REPLACE FIVONDRON WITH UPPER(FIVONDRON)
      SELECT 3 &&Global
      STORE .F. TO Again
   ELSE
     IF UPPER(Decision) ="C'
        STORE .F. TO Again
     ELSE
        STORE .T. TO Again
     ENDIF &&'C'
   ENDIF &&'E'
 ENDDO Again
ENDIF &&EOF() or BOF()
SELECT 2 &&Get
IF UPPER(Decision) <> 'E'
 * IF EOF()
 *    GO TOP
 * ELSE
      SKIP
 * ENDIF
ENDIF &&<>'E'
ENDDO fivondron

* Vérification des codes de la NATURE des Produits.
SELECT 2 &&Get
USE GETDATA
GO TOP
DO WHILE .NOT. EOF()
   STORE STR(RECNO(),5) to Number
   STORE UPPER(NAT-PROD) TO NAT-PROD
   CLEAR
   @ 4,15 SAY " *** VERIFICATION DES CODES Nature de produits ***"
   @ 6,15 SAY " Enrégistrement "+Number
   @ 7,15 SAY " Nature produit : "+NAT_PROD
   STORE SUBSTR(NAT_PROD,1,2) TO Key
   SELECT 3 &&Global
   USE C:GLOBAL INDEX C:G.HP_DX
   FIND &Key
   STORE .T. TO Again
   STORE 'T' TO Decision
   IF (EOF() .OR. BOF())
      DO WHILE Again
         @ 9,10 SAY " Ce PRODUIT n'est pas dans le fichier de référence !"
         @ 11,10 SAY " !E pour l'EDITER."
         @ 12,10 SAY " !C pour CONTINUER (Ignorer)."
         ?
         WAIT TO Decision
         IF UPPER(Decision) ="E'
            SELECT 2 &&Get
            EDIT &Number
            REPLACE NAT PROD WITH UPPER(NAT-PROD)
            SELECT 3 &&Global
            STORE .F. TO Again
         ELSE
            IF UPPER(Decision) ="C'
               STORE .F. TO Again
            ELSE
               STORE .T. To Again
            ENDIF &&'C'
         ENDIF &&'E'
      ENDDO Again
   ENDIF &&EOF() or BOF()
   SELECT 2 &&Get
   IF UPPER(Decision) <>'E'
    * IF EOF()
    *    GO TOP
    * ELSE
         SKIP
    * ENDIF
   ENDIF &&<>'E'
ENDDO nature produit
* Vérification des codes des MOYENS de CONSERVATION.
SELECT 2 &&Get
USE GETDATA
GO TOP
DO WHILE .NOT. EOF()
   STORE STR(RECNO(),5) to Number
   STORE UPPER(CONSERV) TO CONSERV
   CLEAR
   @ 4,15 SAY " *** VERIFICATION DES CODES Moyens de Conservation ***"
   @ 6,15 SAY "Enrégistrement "+Number
   @ 7,15 SAY "Moyen de conservation : "+CONSERV
   STORE SUBSTR(CONSERV,1,2) TO Key
   SELECT 3 &&Global
   USE C:GLOBAL INDEX C:G-CV-DX
   FIND &Key
   STORE .T. TO Again
   STORE 'T' TO Decision
   IF (EOF() .OR. BOF())
      DO WHILE Again
      @!9,10 SAY "Cette CONSERVATION n'est pas dans le fichier de référence !"
      @11,10 SAY " E pour l'EDITER."
      @12,10 SAY " C pour CONTINUER (Ignorer)."
      ?
      WAIT TO Decision
      IF UPPER(Decision) ="E'
         SELECT 2 &&Get
         EDIT &Number
         REPLACE CONSERV WITH UPPER(CONSERV)
         SELECT 3 &&Global
         STORE .F. TO Again
      ELSE
         IF UPPER(Decision) ="C'
            STORE .F. TO Again
         ELSE
            STORE .T. TO Again
         ENDIF &&'C'
      ENDIF &&'E'
   ENDDO Again
ENDIF &&EOF() or BOF()
SELECT 2 &&Get
IF UPPER(Decision) <>'E'
 * IF EOF()
 *    GO TOP
 * ELSE
      SKIP
 * ENDIF
ENDIF &&<>'E'
ENDDO moyen de conservation

SET TALK ON
RELEASE ALL
RETURN
* Retour au sous-programme ADD_2_COS.

COS-COPIE COMMAND FILE

**********************************************************************************************
Ce programme permet de créer une copie de sauvegarde d'une base de données.
Le programme vérifie d'abord si le fichier de destination existe sur la disquette de destination: ensuite, il demande à l'opérateur d'insérer la disquette de source et vérifie l'existence du même fichier sur cette disquette. Si il y a compatibilité, un fichier est créer sur le disque dur et les données sont transférées sur ce dernier. Toutes les données qui se trouvaient sur la disquette de destination sont détruites afin d'éviter que des données soient ajoutées en double.
Finalement, toutes les données sont transférées sur la disquette de destination.
Durant cette procédure, l'opérateur doit dans la mesure du possible tenir compte d'éventuelles coupures de courant qui risqueraient de détruire également la base de données originale.
**********************************************************************************************

* présentation d'un menu pour permettre la sélection du fichier à copier.
STORE SPACE(1) TO Ant
SET BELL ON
CLEAR
* présentation du menu.
@ 6,20 SAY " SAUVEGARDE DE DONNES"
@ 7,20 SAY ' --------------------'
@ 9,15 SAY ' Quelle base de données voulez-vous sauvegarder ?'
@ 11,20 SAY ' -1-  ANTANANARIVO'
@ 12,20 SAY ' -2-  ANTSIRANANA'
@ 13,20 SAY ' -3-  FIANARANTSOA'
@ 14,20 SAY ' -4-  MAHAJANGA'
@ 15,20 SAY ' -5-  TOAMASINA'
@ 16,20 SAY ' -6-  TOLIARA'
@ 18,20 SAY ' -7-  <RETOUR> au menu…' GET Ant
@ 4,5 TO 20,75 DOUBLE
READ
IF Ant ="7'
   RELEASE ALL
   RETURN
ELSE
   CLEAR
   @ 10,10 SAY 'INSEREZ la diskette SOURCE (avec les fichiers)…svp…'
   @ 12,10 SAY ' et taper <RETOUR>'
   ? CHR(7)
   WAIT
   CLEAR
* Vérification que le fichier du choix existe sur la disquette source.
   IF Ant ="1'
      IF .NOT. FILE('A:COS_ANTA.DBF')
         RELEASE ALL
         RETURN
      ENDIF &&not-cos-anta
   ELSE
      IF Ant ="2'
         IF .NOT. FILE('A:COS-ANTS.DBF')
            RELEASE ALL
            RETURN
         ENDIF &&not_cos_ants
      ELSE
         IF Ant ="3'
            IF .NOT. FILE('A:COS_FIAN.DBF')
               RELEASE ALL
               RETURN
            ENDIF &&not_cos_fien
         ELSE
            IF Ant ="4'
               IF .NOT. FILE('A:COS_MAHA.DBF')
                  RELEASE ALL
                  RETURN
            ENDIF &&not-cos-maha
         ELSE
            IF Ant ="5'
               IF .NOT. FILE('A:COS_TOAM.DBF')
                  RELEASE ALL
                  RETURN
            ENDIF &&not_cos_toam
         ELSE
            IF Ant ="6'
               IF .NOT. FILE('A:COS_TULE.DBF')
                   RELEASE ALL
                  RETURN
               ENDIF &&not-cos-tule
            ELSE
               RELEASE ALL
               RETURN
            ENDIF &&Ant=6
         ENDIF &&Ant=5
      ENDIF &&Ant=4
    ENDIF &&Ant=3
  ENDIF &&Ant=2
 ENDIF &&Ant=1
ENDIF &&Ant=7
* création du fichier choisi sur disque dur.
IF Ant ="5'
   USE A:COS-TOAM.DBF
ELSE
   IF Ant ="3'
      USE A:COS-FIAN.DBF
   ELSE
      IF Ant ="6'
         USE A:COS-TULE.DBF
      ELSE
         IF Ant ="4'
            USE A:COS-MAHA.DBF
         ELSE
            IF Ant ="2'
               USE A:COS-ANTS.DBF
            ELSE
               IF Ant ="1'
                  USE A:COS_ANTA.DBF
               ELSE
                  RELEASE ALL
                  RETURN TO MASTER
               ENDIF &&1
            ENDIF &&2
         ENDIF &&4
       ENDIF &&6
    ENDIF &&3
 ENDIF &&5
COPY STRUCTURE TO C:Zip1
USE
USE C:ZIP1.DBF
SET CONSOLE ON
SET TALK ON
* ajout des données du fichier source au fichier du disque dur.
DO CASE
   CASE Ant ="1'
        APPEND FROM A:COS_ANTA.DBF
   CASE Ant ="2'
        APPEND FROM A:COS_ANTS.DBF
   CASE Ant ="3'
        APPEND FROM A:COS_FIAN.DBF
   CASE Ant ="4'
        APPEND FROM A:COS_MAHA.DBF
   CASE Ant ="5'
        APPEND FROM A:COS_TOAM.DBF
   CASE Ant ="6'
        APPEND FROM A:COS_TULE.DBF
ENDCASE
USE
CLEAR
@ 10,10 SAY ' INSEREZ la disquette de DESTINATION…svp…'
@ 12,10 SAY ' et taper <RETOUR>'
? CHR(7)
WAIT
CLEAR
* vérification que le fichier de destination sur disquette de destination
* est le même que celui sur disque dur.
IF Ant ="1'
   IF .NOT. FILE('A:COS-ANTA.DBF')
         RELEASE ALL
         RETURN
      ENDIF &&not-cos-anta
   ELSE
      IF Ant ="2'
         IF .NOT. FILE('A:COS_ANTS.DBF')
            RELEASE ALL
            RETURN
        ENDIF &&not_cos_anta
     ELSE
        IF Ant ="3'
           IF .NOT. FILE('A:COS_FIAN.DBF')
              RELEASE ALL
              RETURN
           ENDIF &&not_cos_fian
        ELSE
           IF Ant ="4'
              IF .NOT. FILE('A:COS_MAHA.DBF')
                 RELEASE ALL
                 RETURN
           ENDIF &&not_cos_maha
        ELSE
           IF Ant ="5'
              IF .NOT. FILE('A:COS_TOAM.DBF')
                 RELEASE ALL
                 RETURN
              ENDIF &&not_cos_toam
           ELSE
              IF Ant ="6'
                 IF .NOT. FILE('A:COS_TULE.DBF')
                    RELEASE ALL
                    RETURN
                 ENDIF &&not_cos_tule
              ELSE
                 RELEASE ALL
                 RETURN
              ENDIF &&Ant=6
           ENDIF &&Ant=5
        ENDIF &&Ant=4
     ENDIF &&Ant=3
  ENDIF &&Ant=2
ENDIF &&Ant=1
ENDIF &&Ant=7
* ajout des données sur fichier de destination aprés avoir détruit toutes
* les données qui s'y trouvaient.
DO CASE
   CASE Ant ="1'
        USE A:COS_ANTA.DBF
   CASE Ant ="2'
        USE A:COS_ANTS.DBF
   CASE Ant ="3'
        USE A:COS_FIAN.DBF
   CASE Ant ="4'
        USE A:COS_MAHA.DBF
   CASE Ant ="5'
        USE A:COS_TOAM.DBF
   CASE Ant ="6'
        USE A:COS_TULE.DBF
ENDCASE
SET SAFETY OFF
ZAP
USE
DO CASE
   CASE Ant ="1'
        USE A:COS-ANTA.DBF
   CASE Ant ="2'
        USE A:COS-ANTS.DBF
   CASE Ant ="3'
        USE A:COS-FIAN.DBF
   CASE Ant ="4'
        USE A:COS-MAHA.DBF
   CASE Ant ="5'
        USE A:COS-TOAM.DBF
   CASE Ant ="6'
        USE A:COS-TULE.DBF
ENDCASE
SET TALK ON
SET CONSOLE ON
APPEND FROM C:ZIP1.DBF
CLOSE DATABASES
DELETE FILE C:ZIP1.DBF
* fin de l'opération de sauvegarde.
CLEAR
@ 10,20 SAY '  La SAUVEGARDE est prète …'
@ 12,20 SAY '  tapez <RETOUR>…'
? CHR(7)
? CHR(7)
WAIT
RELEASE ALL
SET SAFETY ON
SET BELL OFF
RETURN
* retour au menu principal.

COS_MIS(e à) JOUR COMMAND FILE

***********************************************************************************
Les enrégistrements du fichier TEMPORAIRE sont ajoutés au fichier de destination (par province). Cette étape est si cruciale pour l'intégrité qu'un mot de passe est demandé pour avoir accès à cette procédure, ceci afin d'éviter tout accès accidentel.

Le fichier TEMPORAIRE a ensuite tous ces enrégistrements marqués pour effacement une fois que ces derniers ont été transférés sur les fichiers de destination.
**********************************************************************************

* Procédure d'accès au sous-programme.
USE
SET TALK OFF
@ 4,10 SAY " ************************************************************ "
@ 6,10 SAY " ASSUREZ-vous que TOUT est CORRECT dans le fichier TEMPORAIRE"
@ 8,10 SAY " avant d'entrer le CODE pour Continuer !!"
@ 10,10 SAY " *************************************************************"
SET CONSOLE OFF
ACCEPT TO Lock
SET CONSOLE ON
IF UPPER(Lock) <> 'FAO'
   @ 12,12 SAY "            ACCES non autorisé"
   @ 14,12 SAY "  Vous avez 5 secondes avant le crash fatal…"
   STORE 1 TO X
   DO WHILE X < 25
      STORE X+1 TO X
   ENDDO
   RELEASE Lock
   RETURN
ELSE
* présentation d'un menu pour permettre la vérification du fichier de
* destination.
   CLEAR
   STORE SPACE(1) TO Reply
   @ 5,10 SAY "          Quel fichier voulez-vous METTRE A JOUR ?"
   @ 7,10 SAY "	     -1-   ANTANANARIVO"
   @ 8,10 SAY "	     -2-   ANTSIRANANA"
   @ 9,10 SAY "	     -3-   FIANARANTSOA"
   @ 10,10 SAY "     -4-   MAHAJANGA"
   @ 11,10 SAY "     -5-   TOAMASINA"
   @ 12,10 SAY "     -6-   TOLIARA"
   @ 14,10 SAY "   … <RETOUR> … au menu."
   @ 15,10 SAY "     Choisissez un nombre …" GET Reply
   @ 4,12 TO 16,66
READ
CLEAR
* Vérification de la concordance des fichiers.
   @ 5,10 SAY "Vérification des enrégistrements du fichier TEMPORAIRE : "
   IF Reply ="1' .OR. Reply ="2' .OR. Reply ="3' .OR. Reply ="4';
      .OR. Reply ="5' .OR. Reply ="6'
      USE A:TEMPFILE
   ELSE
      USE
      RELEASE ALL
      RETURN
   ENDIF
   COUNT FOR .NOT. DELETE() TO None
* Si le fichier TEMPFILE est vide, il n'y a pas de transfert de données.
   IF None = 0
      @ 6,10 SAY "Pas de nouveaux enrégistrements dans le fichier TEMPORAIRE."
      @ 7,10 SAY "… <RETOUR> pour Continuer."
      WAIT
   ELSE
      USE
      IF Reply ="5'
         USE A:COS_TOAM.DBF
   ELSE
      IF Reply ="3'
         USE A:COS_FIAN.DBF
      ELSE
         IF Reply ="6'
            USE A:COS_TULE.DBF
         ELSE
            IF Reply ="4'
               USE A:COS_MAHA.DBF
            ELSE
               IF Reply ="2'
                  USE A:COS_ANTS.DBF
               ELSE
                  IF Reply ="1'
                     USE A:COS_ANTA.DBF
                  ELSE
                     USE
                     RETURN
                  ENDIF 6
               ENDIF 5
            ENDIF 4
         ENDIF 3
      ENDIF 2
   ENDIF 1
   CLEAR
* Transfert des nouvelles données du fichier TEMPFILE vers le fichier de
* destination.
     @ 5,10 SAY "       *** NE ** PAS ** INTERROMPRE ***"
     @ 9,10 SAY " *** TRANSFERT DE DONNEES VERS LA BASE DE DONNEES ***"
     APPEND FROM A: TEMPFILE
     USE A: TEMPFILE
     DELETE ALL
   ENDIF none
   USE
   RELEASE ALL
   RETURN
ENDIF lock
* fin du sous-programme de mise à jour.

M(a)K(e) F(i)L(e) COMMAND FILE

******************************************************************************************
Ce sous-programme permet de préparer tous les fichiers sur une nouvelle disquette. La nouvelle disquette doit être néanmoins FORMATTEE d'avance.
******************************************************************************************

* présentation d'un menu en vue de déterminer les fichiers à créer sur la
* nouvelle disquette.
CLEAR
@ 6,15 SAY "      PREPARATION D'UNE NOUVELLE DISQUETTE"
@ 7,15 SAY '      ------------------------------------'
@ 9,0 SAY ' pour quelle PROVINCE voulez-vous préparer une nouvelle disquette ?'
@ 11,15 SAY ' -1- ANTANANARIVO'
@ 12,15 SAY ' -2- ANTSIRANANA'
@ 13,15 SAY ' -3- FIANARANTSOA'
@ 14,15 SAY ' -4- MAHAJANGA'
@ 15,15 SAY ' -5- TOAMASINA'
@ 16,15 SAY ' -6- TOLIARA'
?
ACCEPT '         -7- <RETOUR> au menu…' TO Ant
IF Ant ="7'
   RELEASE ALL
   RETURN
ELSE
* vérification de la disquette <source>.
  IF (Ant="1' .OR. Ant="2' .OR. Ant="3' .OR. Ant="4' .OR. Ant="5' .OR. Ant="6')
   CLEAR
   @ 10,10 SAY 'INSEREZ la diskette SOURCE (avec les finchiers)… svp…'
   @ 12,10 SAY ' et taper <RETOUR>'
   WAIT
   CLEAR
   IF Ant ="5'
      USE A:COS_TOAM.DBF
   ELSE
      IF Ant ="3'
         USE A:COS_FIAN.DBF
      ELSE
         IF Ant ="6'
            USE A:COS_TULE.DBF
         ELSE
            IF Ant ="4'
               USE A:COS_MAHA.DBF
            ELSE
               IF Ant ="2'
                  USE A:COS-ANTS.DBF
               ELSE
                  IF Ant ="1'
                     USE A:COS-ANTA.DBF
                  ELSE
                     RELEASE ALL
                     RETURN TO MASTER
                  ENDIF 6
               ENDIF 5
            ENDIF 4
         ENDIF 3
      ENDIF 2
   ENDIF 1
 ENDIF
ENDIF 7
* Copiage de la structure des fichiers.
COPY STRUCTURE TO C:Zip1
USE
@ 10,10 SAY 'INSEREZ la disquette de DESTINATION (VIERGE et FORMATTEE)… svp…'
@ 12,10 SAY '      et taper <RETOUR>'
WAIT
CLEAR
USE Zip1
IF Ant ="5'
   COPY STRUCTURE TO A:COS_TOAM.DBF
   COPY STRUCTURE TO A:TEMPFILE
   USE A:COS_TOAM.DBF
ELSE
   IF Ant ="3'
     COPY STRUCTURE TO A:COS_FIAN.DBF
     COPY STRUCTURE TO A:TEMPFILE
     USE A:COS-FIAN.DBF
   ELSE
      IF Ant ="6'
         COPY STRUCTURE TO A:COS_TULE.DBF
         COPY STRUCTURE TO A:TEMPFILE
         USE A:COS-TULE.DBF
      ELSE
         IF Ant ="4'
            COPY STRUCTURE TO A:COS_MAHA.DBF
            COPY STRUCTURE TO A:TEMPFILE
            USE A:COS-MAHA.DBF
         ELSE
            IF Ant ="2'
               COPY STRUCTURE TO A:COS_ANTS.DBF
               COPY STRUCTURE TO A:TEMPFILE
               USE A:COS-ANTS.DBF
            ELSE
               IF Ant ="1'
                  COPY STRUCTURE TO A:COS_ANTA.DBF
                  COPY STRUCTURE TO A:TEMPFILE
                  USE A:COS-ANTA.DBF
               ELSE
                  USE
                  RELEASE ALL
                  RETURN
               ENDIF 6
            ENDIF 5
         ENDIF 4
      ENDIF 3
   ENDIF 2
ENDIF 1
* fin du processus de création de fichiers et remise à l'état d'origine.
CLOSE DATABASES
DELETE FILE C:ZIP1.DBF
CLEAR
@ 10,20 SAY '        La DISQUETTE EST prète …'
@ 12,20 SAY '            tapez <RETOUR>…'
@ 16,20 SAY " n'oubliez pas d'écrire les étiquettes (+l'année)"
WAIT
RELEASE ALL
RETURN
* retour au menu principal.

PRINTOUT COMMAND FILE

***********************************************************************************************
Ce programme est utilisé par le programme ADD_COS.CMD. Il imprime un listing des enrégistrements dans un fichier.
La sortie est espacée tout les 10 enrégistrements et l'imprimante est à nouveau positionnée sur la marge gauche après l'impression.

La commande d'appel détermine ou l'impression débute en spécifiant une valeur pour la variable "NUMBER"

Pour voir les numéros des enrégistrements utilisez le programme REVIEW.CMD.
************************************************************************************************

* initialisation de la routine.
IF VAL(Number)>0
   GOTO RECORD &Number
ELSE
  GO TOP
ENDIF
STORE 0 TO Count
DO WHILE .NOT. EOF()
   IF DELETED()
      SKIP
   ELSE
      DISPLAY OFF &&CONDITION
      SKIP
      IF UPPER(Output) = "0"
         SET TALK OFF
         STORE Count+1 TO Count
      ENDIF
         IF Count = 10
            STORE 0 TO Count

* donne une ligne d'espace touts les 10 enrégistrements, puis attend.
* déconnecte l'imprimante de manière que le 'WAIT' n'imprime pas.
            ?
            SET PRINT OFF
            WAIT
            IF UPPER(Output) ="0'
               SET PRINT ON
               ?? CHR(15)
            ENDIF
         ENDIF
      ENDIF
   ENDDO

* Les 2 lignes suivantes repositionnent l'imprimante sur la marge gauche.
  ?
  ?
  ?? CHR(18)
  SET PRINT OFF
  RELEASE Count, Output
  RETURN
* retour au programme apellant.

REVIEW COMMAND FILE

******************************************************************************************
Ce programme est utilisé pour revoir les données dans nimporte quelle base de données .DBF. La base de données doit être nomée dans la commande appelant la procédure. Les données peuvent être listées conditionellement avec ou sans son numero de donnée.

Les enrégistrements sont listés en groupes de 10 avec une ligne d'espace entre chaque groupe. Le listing peut démarrer à un enrégistrement donné et les dossiers peuvent être ré-édités autant de fois qu'on le désire. Le listing peut être continu ou s'arrêter après 10 enrégistrements.

L'impression sur papier est optionelle.
******************************************************************************************

* initialisation de la routine.
SET HEADING OFF
SET SAFETY OFF
STORE 'O' TO Reviewing

* boucle principale.
DO WHILE UPPER (Reviewing) ="0'
   COPY STRUCTURE EXTENDED TO Temp
   GO BOTTOM
   SET TALK OFF
   STORE STR(RECND(),5) TO Last
   CLEAR
   ?
   ?
   ? 'La base de données '+UPPER(Database)+' à '-Last+' entrées.  Elles seront'
   ? 'montrées en groupes de 10 enrégistrements, 50 enrégistrements pour'
   ? 'une page si ils sont imorimés'
   ? 'Entrez de nouvelles valeurs pour les défaults ou pressez <RETOUR>'
   ?
 ? '**** VISUALISATION [ LISTE CHAMPS ] [ POUR < EXPRESSION > ] [ OFF ] *****'
   ?
   STORE 1 TO First
   STORE 1 to PageCnt
   STORE VAL (Last) TO RecoCnt
   STORE 'N' TO Pause
   STORE 'N' TO Partial
   STORE 'N' TO Conditions
   STORE 'N' TO Tally
   STORE 'C' TO Changing
   SET TALK ON
   DO WHILE UPPER (Changing) ="C'
      @ 10,10 SAY ' DEMARRAGE à enrégistrement numéro ' GET First
      @ 11,10 SAY ' ARPET à enrégistrement numéro ' GET RecoCnt
      @ 12,10 SAY ' DEMARRASE numérotation papier à ' GET PageCnt
      @ 13,10 SAY ' PAUSER tout les 10 enrégistrements ' GET Pause
      @ 14,10 SAY ' MONIPER les champs séléctionnés ' GET Partial
      @ 15,10 SAY ' DISPLAY pour expression ' GET Conditions
      @ 16,10 SAY ' MONTRER numéro suréoistrements ' GET Tally
      ?
      ? ' <C> pour CHANGER les valeurs de défault,'
      ? ' <RETOUR> pour Continuer…'
      WAIT TO Changing
      IF UPPER (Changing) ="C'
* vide jusqu' à la fin de l'écran.
         @ 15,0 SAY CHR (27)+CHR(74)
         READ
      ELSE
         IF First > VAL (Last) .OR. First <= 0 .OR. RecoCnt > VAL(Last) ;
                           .OR. RecoCnt<=0
            @ 15,0 SAY CHR(27)+CHR(74)
            @ 16,0 SAY 'Erreur, numére erroné : '-UPPER(Database)+;
                 ' contient les enrégistrements du numéro 1 à '+Last+'.'
            ? '    <RETOUR> pour corriger votre entrée.'
            WAIT
            @ 15,0 SAY CHR(27)+CHR(74)
            STORE 'C' TO Changing
            STORE 1 TO First
            STORE VAL(Last) TO RecoCnt
         ENDIF
      ENDIF

* Nettoye l'écran jusqu'à la fin
  @ 15,0 SAY CHR(27)+CHR(74)
  ENDDO
  ?
  ?
  IF UPPER(Partial) ="0'
     CLEAR
     @ 11,0 SAY CHR(27)+CHR(74)
     @ 11,0 SAY 'Les CHAMPS de la base de données '+UPPER(Database)+' sont :'
     USE Temp
     SET CONSOLE OFF
     ?
     STORE ' ' TO Choices
     DO WHILE .NOT. EOF()
        STORE Choices+TRIM(FIELD-name)+',' TO Choices
     SKIP
     ENDDO
     STORE SUBSTR(Choices,2,LEN(Choices)-3) TO Choices
     SET CONSOLE ON
     STORE '0' TO Unfinished
     DO WHILE UPPER(Unfinished) ="0'
        CLEAR
        @ 13,0 SAY Choices

        USE A:&Database
        ?
        ? 'Donnez les CHAMPS àMONTRER (<RETOUR> pour les montrer tous).'
        ? "tapez une virgule entre deux CHAMPS successifs !"
*!! There will be no automatic colon following this prompt string.
        ACCEPT "DISPLAY" TO Partial
        STORE UPPER(Partial) TO Partial
        STORE Partial TO String
        STORE LEN(String) TO Size

        IF Size =0 .OR. (Size =1 .AND. Partial =" ')
           STORE CHR(0) TO Partial
           STORE 'N' TO Unfinished
        ELSE
           ?
           ? ' Voulez-vous changer votre sélection (O/N) ? '
           WAIT TO Unfinished
           IF UPPER(Unfinished) ="0'
              @ 12,0 SAY CHR(27)+CHR(74)
           ELSE
              @ 10,0 SAY CHR(27)+CHR(74)
              ? '*** Vérification des Champs ['+Partial+'] : '
              SET TALK OFF
              STORE 0 TO FF
              STORE 0 TO Counter
              DO WHILE Size > 0
                 STORE Counter+1 TO Counter
                 ?? '*'+STR(Counter,2)
                 STORE AT(',', String) TO Mark
                 IF Mark =1 .OR. Mark =Size
                    ? ' Uh, oh…Problèmes : Virgule ne peut être au ';
                       +" début ou à la fin d'une liste de valeurs."
                    ? ' <RETOUR> et essayez encore une fois…'
                    STORE 0 TO Size
                    STORE '0' TO Unfinished
                    WAIT
                 ELSE
                    IF Mark > 0
                       STORE (Mark-1) TO Size
                    ENDIF
                    STORE .T. TO Blank
                    STORE 1 TO Start
                    DO WHILE Blank .AND. (.NOT. Start > Size)
                       IF SUBSTR(String, Start,1) =" '
                          STORE (Start+1) TO Start
                       ELSE
                          STORE (.NOT. Blank) TO Blank
                       ENDIF
                    ENDDO
                    IF Start > Size
                    ? ' Comment est-ce possible de trouver un champ vierge ? '
                    ? '   <RETOUR> et essayez encore une fois.'
                       STORE 0 TO Size
                       STORE '0' TO Unfinished
                       WAIT
                    ELSE
                       IF FF < 10
                          STORE STR(FF,1) TO Suffix
                       ELSE
                          STORE STR(FF,2) TO Suffix
                       ENDIF
                       STORE 'FIELD'+Suffix TO Field
                    STORE TRIM (SUBSTR(String, Start, (Size-Start+1))) to &Field
                       IF Mark > 0
                          STORE TRIM (SUBSTR(String, (Size+2))) TO String
                          STORE LEN(String) TO Size
                       ELSE
                          STORE 'N' TO Unfinished
                          STORE 0 TO Size
                       ENDIF
                    ENDIF
                 ENDIF
              ENDDO
              SET TALK ON
           ENDIF
        ENDIF
     ENDDO
* pas installé.
*       IF LEN(Partial) > 0
*          Do Headings
*          ?' We will do the headings here.'
*          WAIT
*       ENDIF
     ELSE
        STORE CHR(0) TO Partial
     ENDIF

     IF UPPER(Conditions) ="0'
        STORE '0' TO Unfinished
        DO WHILE UPPER(Unfinished) ="0'
           CLEAR
           @ 11,0 SAY "Specifiez l'expression ou <RETOUR> pour sauter."
           ?
           ? ' DISPLAY &Partial FOR '
           ACCEPT TO Expression
           ?
           ? "Voulez-vous changer l'expression (O/N) ?"
           WAIT TO Unfinished
        ENDDO

  IF Expression > ' '
     STORE 'FOR' +Expression TO Conditions
  ELSE
     STORE CHR(0) TO Conditions
  ENDIF
ELSE
     STORE CHR(0) TO Conditions
ENDIF

IF UPPER(Tally) <> '0'
   STORE 'OFF' TO Tally
ELSE
   STORE CHR(0) TO Tally
ENDIF

STORE [DISPLAY Next 1 &Partial &Conditions &Tally] TO Command
CLEAR

@ 11,0 SAY CHR(27) +CHR(74)
@ 11,0 SAY '***' +CD[DISPLAY &Partial &Conditions &Tally]+' *** '
?
? ' est la commande qui sera effectuée sur la base de données ';
        +UPPER(database)
? '  <C> pour la Changer,'
? '  <Q> pour Quitter sans action,'
? '  <RETOUR> pour Revoir la base de données.'
WAIT TO Abort

IF UPPER(Abort) ="Q'
   STORE CHR(0) TO Reviewing
ELSE
  IF UPPER(Abort) <> 'C'
     CLEAR
  ? " Entrez une ligne d'entête ou pressez <RETOUR> pour sauter."
  ACCEPT TO Message
  STORE UPPER(Message) TO Message
  ?
  STORE 0 TO Count
  STORE 0 TO Pagemark
  STORE STR(First.5) TO Number
  GO &Number

  CLEAR
  ? 'Voulez-vous IMPRIMER le listing maintenent (O/N) ? '
  ACCEPT TO Hardcopy

  IF UPPER(Hardcopy) ="0'
     SET PRINT ON
     ?? CHR(15)
     DO Revmrgn
  ENDIF
     CLEAR
  ? Message
  ? ' Page ' +STR(PageCnt,3)

  IF Tally ="OFF'
     ?? " démarrez à l'enrégistrement # "-STR(RECNO(),5)
     ?
     IF .NOT. (Partial > ' ' .OR. Conditions >' ')
        DO Revhdr
     ENDIF
     DO WHILE .NOT. EOF() .AND. RECNO() <= RecoCnt
*!!  Macros used as commands cannot be converted by dCONVERT.
            &Command

            IF UPPER(Conditions) > CHR(0)
               SET TALK OFF
               IF &Expression
                  SET PRINT OFF
                  STORE (Count+1) TO Count
                  SET PRINT ON
               ENDIF
            ELSE
               SET PRINT OFF
               STORE (Count+1) TO Count
               SET PRINT ON
               SET TALK OFF
            ENDIF
*           SET TALK ON
            SKIP
            IF Count = 10
               SET TALK OFF
               STORE 0 TO Count

* Inserre un espace tous les dix enrégistrements, puis attends.
* L'imprimante est déconnectéede sorte que "WAIT" n'est pas imprimé.
            ?
            SET PRINT OFF
            SET TALK ON
            IF UPPER(Pause) ="O'
               WAIT
            ENDIF

            IF UPPER(Hardcopy) ="O'
               SET PRINT ON
            ENDIF

* La routine suivante imprime 50 entrées à la page, puis continue à la
* page suivante et imprime l'entête.

            STORE (Pagemark+1) TO Pagemark
            IF Pagemark = 5
            ?
            ?
            ?
            ?
            STORE (PageCnt+1) TO PageCnt

            IF INT(PageCnt/7) = PageCnt/7
            ?
            ENDIF

            ? Message
            ? ' Page ' +STR(PageCnt,3)

            IF Tally ="OFF'
               ?? " Démarre à l'enrégistrement # '-STR(RECNO(),5)
               ?
               IF .NOT. (Partial > ' ' .OR. Condition > ' ')
                  DO Revhdr
               ENDIF
            ENDIF
            ?
            STORE 0 TO Pagemark
         ENDIF
      ENDIF
   ENDDO
* Formfeed on printer
*      ? CHR(12)
       ?
       ?
       SET PRINT OFF
       ? 'Voulez-vous REVOIR la base de données '+UPPER(Database)+' (O/N) ?.'
       WAIT TO Reviewing
    ELSE
       STORE 'O' TO Reviweing
    ENDIF
 ENDIF
 ?
ENDDO Reviewing

Revmrgn Command File

*********************************************************************************************
Utilisé par le programme Review CMD File en vue de fixer les marges pour le listing de différentes BASES de DONNEES.
*********************************************************************************************

IF UPPER(Database) = "A:COS_TOAM.DBF" .OR. UPPER(Database) = "A:COS_FIAN.DBF"
   SET MARGIN TO 10
ELSE
   IF UPPER(Database) ="A:COS_TULE.DBF)" .OR. UPPER(Database)="A:COS_MAHA.DBF"
      SET MARGIN TO 10
   ELSE
      IF UPPER(Database) ="A:COS_ANTS.DBF".OR.UPPER(Database)="A:COS-ANTA.DBF"
         SET MARGIN TO 10
     ENDIF
  ENDIF
ENDIF
RETURN

* finalisation du sous-programme
USE
DELETE FILE Temp.DBF
RELEASE ALL
RETURN
* retour au programme apellant

Revhdr Command File

*********************************************************
Utilisé par le PROGRAMME REVIEW pour imprimer l'entête des listings.
*********************************************************

SET PRINT ON
? "FAR FIV N-P CON EXPE DEST QUANTITE VALEUR MT DATE"
RETURN

EXP(édition)-MEN(Suelle) COMMAND FILE

************************************************************************************************
Ce programme initialise le traitement des données des cos. A partir du menu l'opérateur peut choisir quel type de résultats il désire.

Le programme permet de vérifier si les bases de données sur disquette sont en relation avec la sélection des choix du menu et permet le transfert des données vers le disque dur. L'opérateur peut aussi choisir s'il veut des résultats mensuels par fivondron ou des résultats annuels par faritany (ceci selon le programme choisi).
************************************************************************************************

* présentation du menu.
SET SAFETY OFF
STORE .T. TO Check
DO WHILE Check
   CLEAR
   STORE SPACE(1) TO Reply
   @ 2,3 TO 18,78 DOUBLE
   @ 4,20 SAY " ***  EXPEDITIONS HORS FIVONDRONANA *** "
   @ 5,20 SAY "      -----------------------------     "
   @ 7,17 SAY "-1- EXPEDITIONS par NATORE du PRODUIT"
   @ 8,17 SAY "-2-             par MOYEN de CONSERVATION"
   @ 9,17 SAY "-3-             par DESTINATION / NATURE du PRODUIT"
   @ 10,17 SAY "-4-            par DESTINATION / MOYEN DE CONSERVATION"
   @ 11,17 SAY "-5-            par EXPEDITEUR / par NATURE du PRODUIT"
   @ 13,17 SAY "-6- EXPORTATIONS par DESTINATION / MOYEN de CONSERVATION"
   @ 14,17 SAY "-7-              par EXPEDITEUR / NATURE des PRODUITS"
   @ 16,17 SAY "-8-  <RETOUR> au menu précédent : " GET Reply
   READ
   IF Reply ="8'
      USE
      RELEASE ALL
      RETURN
   ELSE
* sélection des paramètres et choit des résultats par mois ou par année,
* par FIVONDRONANA ou par FARITANY.
IF (Reply ="1' .OR. Reply="2' .OR. Reply="3' .OR. Reply ="4' .OR. Reply="5';
   .OR. Reply="6" .OR. Reply="7")
             STORE ' ' TO Far
             CLEAR
             @ 5,10 SAY "pour quel FARITANY (codes de l à 6) ?" GET Far
             @ 2,3 TO 14,73 DOUBLE
             READ
* déplacement du texte de programme vers la marge de gauche.
IF (Reply="1" .OR. Reply="2" .OR. Reply="3" .OR. Reply="4" .OR. Reply="5')
    STORE SPACE(3) TO Fiv
    STORE SPACE(1) TO Des
    STORE SPACE(2) TO Mois
    @ 7,10 SAY "pour quel FIVONDRONANA (codes de 103 à 622) ? " GET Fiv
    IF Reply <> '4'
       @ 10,5 SAY "entrez CODE '000' pour résultats ANNUELS / FARITANY"
@ 11,5 SAY "entrez CODE '103' à '622' pour résultats MENSUELS / FIVONDRONANA"
       @ 2,3 TO 14,73 DOUBLE
       READ
       IF Fiv <> "000"
          IF (Reply <> '1' .OR. Reply <> '2')
              @ 12,5 SAY " à partir de quel mois ? "GET Mois
              READ
          ENDIF
       ENDIF
       @ 2,3 TO 14,73 DOUBLE
    ENDIF
ENDIF
IF Reply ="4'
   STORE SPACE (1) TO Res
   @ 10,10 SAY " résultats mensuels -1- ou annuels -2- ?" GET Res
   READ
   IF Res ="2'
      STORE '2' TO Des
      STORE Fiv TO Fiv_1
      STORE "000" TO Fiv
   ELSE
      IF Res = "1"
         STORE '1' TO Des
         STORE Fiv TO Fiv_1
         @ 12,10 SAY " à partir de quel mois ? "GET Mois
         READ
      ENDIF
   ENDIF
ENDIF
* déplacement du texte de programme vers la position initiale.
         ENDIF &&Reply=1…5
         IF (Reply="3" .OR. Reply="5')
            IF Fiv = "000"
               STORE "2" TO Des
            ELSE
               STORE '1' TO Des
            ENDIF
         ENDIF &&Reply=3,5
         IF (Reply = "6" .OR. Reply = "7")
            STORE SPACE(1) TO Res
            STORE SPACE(2) TO Mois
            STORE SPACE(3) TO Fivon
            @ 8,10 SAY " Pour quel FIVONDRONANA ?"
   @ 9,10 SAY "Code '000' pour tous les FIVONDRONANA du FARITANY ? " GET Fivon
            READ
            @ 10,10 SAY " Résultats mensuels -1- ou annuels -2- ? " GET Res
            READ
            IF Res ="1'
               @ 11,10 SAY " à partir de quel mois ? " GET Mois
               READ
            ENDIF
               ENDIF &&Reply=6,7
         ELSE
            RELEASE ALL
            RETURN
         ENDIF &&1…7
         CLEAR

* vérification des bases de données.  La disquette en a: doit avoir les
* données du faritany séléctionné.
        IF Far ="5'
           IF .NOT. FILE('A:COS_TOAM.DBF')
              RELEASE ALL
              RETURN
           ENDIF
        ELSE
           IF Far ="3'
              IF .NOT. FILE('A:COS_FIAN.DBF')
                 RELEASE ALL
                 RETURN
              ENDIF
           ELSE
              IF Far ="6'
                 IF .NOT. FILE('A:COS_TULE.DBF')
                    RELEASE ALL
                    RETURN
                 ENDIF
              ELSE
                 IF Far = "4"
                    IF .NOT. FILE('A:COS_MAHA.DBF')
                       RELEASE ALL
                       RETURN
                    ENDIF
                 ELSE
                    IF Far = "2"
              IF .NOT. FILE('A:COS_ANTS.DBF')
                 RELEASE ALL
                 RETURN
              ENDIF
           ELSE
              IF Far = "1"
                 IF .NOT. FILE('A:COS_ANTA.DBF')
                    RELEASE ALL
                    RETURN
                 ENDIF
              ELSE
                 RELEASE ALL
                 RETURN
              ENDIF &&1
            ENDIF &&2
         ENDIF &&4
      ENDIF &&6
   ENDIF &&3
 ENDIF &&5
ENDIF &&6

* sélection des bases de données à utiliser ultérieurement.
  DO CASE
     CASE Far = "5"
          USE A:COS-TOAM.DBF
     CASE Far = "3"
          USE A:COS-FIAN.DBF
     CASE Far = "6"
          USE A:COS-TULE.DBF
     CASE Far = "4"
          USE A:COS-MAHA.DBF
     CASE Far = "2"
          USE A:COS-ANTS.DBF
     CASE Far = "1"
          USE A:COS-ANTA.DBF
     OTHERWISE
          RELEASE ALL
          USE
          RETURN
  ENDCASE

* copie de la structure de la base de données sur disque dur.
   COPY STRUCTURE TO C:ZIPZIP
   USE ZIPZIP

* en fonction du choix effectué dans le menu les données sont transférées
* sur disque dur.
    IF (Reply="1" .OR. Reply="2" .OR. Reply="3" .OR. Reply="4" .OR. Reply="5')
        IF Fiv <> "000"
           DO CASE
              CASE Far = "5"
                   APPEND FROM A:COS-TOAM.DBF FOR FIVONDRON = Fiv
              CASE Far = "3"
                   APPEND FROM A:COS-FIAN.DBF FOR FIVONDRON = Fiv
              CASE Far = "4"
                   APPEND FROM A:COS-MAHA.DBF FOR FIVONDRON = Fiv
              CASE Far = "6"
                   APPEND FROM A:COS-TULE.DBF FOR FIVONDRON = Fiv
              CASE Far = "2"
                   APPEND FROM A:COS-ANTS.DBF FOR FIVONDRON = Fiv
              CASE Far = "1"
                   APPEND FROM A:COS-ANTA.DBF FOR FIVONDRON = Fiv
           ENDCASE
        ELSE
           IF Fiv = "000"
              DO CASE
                 CASE Far = "1"
                      APPEND FROM A:COS-ANTA.DBF
                 CASE Far = "2"
                      APPEND FROM A:COS-ANTS.DBF
                 CASE Far = "3"
                      APPEND FROM A:COS-FIAN.DBF
                 CASE Far = "4"
                      APPEND FROM A:COS-MAHA.DBF
                 CASE Far = "5"
                      APPEND FROM A:COS-TOAM.DBF
                 CASE Far = "6"
                      APPEND FROM A:COS-TULE.DBF
              ENDCASE
           ENDIF &&Fiv ="000"
        ENDIF &&Fiv<>"000"
     ENDIF &&Reply="1,2,3,4,5"
     IF (Reply = "6" .OR. Reply = "7")
         STORE STR (701,3) TO Z
         STORE STR(720,3) TO ZZ
         IF (Res ="2' .OR. Res = "1")
             DO CASE
                CASE Far = "5"
             APPEND FROM A:COS_TOAM.DBF FOR (DESTIN > Z .AND. DESTIN < ZZ)
                    CASE Far = "3"
             APPEND FROM A:COS_FIAN.DBF FOR (DESTIN > Z .AND. DESTIN < ZZ)
                    CASE Far = "4"
             APPEND FROM A:COS_MAHA.DBF FOR (DESTIN > Z .AND. DESTIN < ZZ)
                    CASE Far = "6"
             APPEND FROM A:COS_TULE.DBF FOR (DESTIN > Z .AND. DESTIN < ZZ)
                    CASE Far = "2"
             APPEND FROM A:COS_ANTS.DBF FOR (DESTIN > Z .AND. DESTIN < ZZ)
                    CASE Far = "1"
             APPEND FROM A:COS-ANTA.DBF FOR (DESTIN > Z .AND. DESTIN < ZZ)
                    ENDCASE
         ELSE
            RELEASE ALL
            RETURN
         ENDIF &&res=1,2
      ENDIF && reply=6,7
* le programme est dirigé vers des sous-programmes en fonction du choix
* effectué dans le menu (en fonction des tableaux désirés).
  DO CASE
     CASE Reply = "1"
* expédition mensuelle/annuelle à partir d'un fivondronana d'origine,
* présentation des résultats par nature des produits.
       DO EX_1_MEN
          CASE Reply = "2"
* expédition mensuelle/annuelle à partir d'un fivondronana d'origine,
* présentation des résultats par moyen de conservation.
       DO EX_2_MEN
          CASE Reply = "3"
* expédition mensuelle/annuelle à partir d'un fivondronana d'origine,
* présentation des résultats par nature des produits et par fivondronana
* /pays étranger de destination.
       DO EX_3_MEN
          CASE Reply = "4"
* expédition mensuelle/annuelle à partir d'un fivondronana d'origine,
* présentation des résultats par moyen de conservation et par fivondronana
* /pays étranger de destination.
       DO EX_4_MEN
          CASE Reply = "5"
* expédition mensuelle/annuelle à partir d'un fivondronana d'origine,
* présentation des résultats par nature du produit et par expéditeur.
       DO EX_5_MEN
          CASE Reply = "6"
* exportation mensuelle/annuelle à partir d'un fivondronana d'origine,
* présentation des résultats par moyen de conservation et par pays de
* destination.
      DO EXPORT_1
         CASE Reply = "7"
* exportation mensuelle/annuelle à partir d'un faritany d'origine,
* présentation des résultats par nature des produits et par pays de
* destination.
        DO EXPORT_2
    OTHERWISE
        RELEASE ALL
        RETURN
    ENDCASE
    STORE .F. TO Check
ENDDO Check
USE
SET SAFETY ON
RELEASE ALL
RETURN
* retour au menu principal.

EX (pédition)_1_MEN(suelle) COMMAND FILE

***********************************************************************************************
Ce programme calcule, par mois, les expéditions hors fivondronana par nature des produits. Les données ont été transférées sur disgue dur pour raison de sécurité. Le programme traite UNIQUEMENT LES EXPEDITIONS ET NON LES EXPORTATIONS à partir du fivondronana.

Les résultats sont présentés mensuellement par fivondronana ou annuellement par faritany (tous les fivondronana du faritany).
***********************************************************************************************

* création de deux fichiers additionnels pour un traitement plus rapide.
USE C:ZIPZIP
COPY STRUCTURE TO C:ZIP_2.DBF
COPY STRUCTURE TO C:Zip_3.DBF
USE
* permet au SETUP de fonctionner proprement, n'est pas nécessaire.
STORE '1' TO Part
DO SETUP
SET PRINT OFF
DO LINE
SET CONSOLE OFF
SET TALK OFF
STORE .T. TO Process
USE C:Zip_3
APPEND FROM C:Zipzip FOR(DESTIN < "700")
USE &&closeZip_3

* si le choix est "tous les FIVONDRONANA du FARITANY".
IF Fiv ="000'
   STORE 0 TO Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12,Q13,Q14,Q15,Q16,Q17,Q18
   STORE 0 TO Q19,Q20,V1,V2,V3,V4,V5,V6,V7,V8,V9,V10,V11,V12,V13,V14,V15,V16
   STORE 0 TO V17,V18,V19,V20
* initialisation des paramétres selon le faritany.
  DO CASE
     CASE Far ="1'
          STORE '103' TO Y
     CASE Far ="2'
          STORE '202' TO Y
     CASE Far ="3'
          STORE '302' TO Y
     CASE Far ="4'
          STORE '402' TO Y
     CASE Far ="5'
          STORE '502' TO Y
     CASE Far ="6'
          STORE '602' TO Y
  ENDCASE
ENDIF

* boucle principale.
DO WHILE Process

* si le choix est "un seul fivondronana" du FARITANY; résultat mensuels.
   IF Fiv <> '000'
      STORE 1 TO Tel
      DO WHILE Tel <13
         STORE ' ' TO X
         IF Tel<10
            STORE '0'+STR(Tel,1) TO X
         ELSE
            STORE STR (Tel,2) TO X
         ENDIF
         USE C: Zip_2.DBF &&open

* traitement par mois.
        APPEND FROM C:Zip_3 FOR(SUBSTR(DTOC(DATE),4,2) = X)
        SUM QUANTITE,VALEUR TO Q1,V1 FOR (NAT-PROD ="01')
        SUM QUANTITE,VALEUR TO Q2,V2 FOR (NAT-PROD ="02')
        SUM QUANTITE,VALEUR TO Q3,V3 FOR (NAT-PROD ="03')
        SUM QUANTITE,VALEUR TO Q4,V4 FOR (NAT-PROD ="04')
        SUM QUANTITE,VALEUR TO Q5,V5 FOR (NAT-PROD ="05')
        SUM QUANTITE,VALEUR TO Q6,V6 FOR (NAT-PROD ="06')
        SUM QUANTITE,VALEUR TO Q7,V7 FOR (NAT-PROD ="07')
        SUM QUANTITE,VALEUR TO Q8,V8 FOR (NAT-PROD ="08')
        SUM QUANTITE,VALEUR TO Q9,V9 FOR (NAT-PROD ="09')
        SUM QUANTITE,VALEUR TO Q10,V10 FOR (NAT-PROD ="10')
        SUM QUANTITE,VALEUR TO Q11,V11 FOR (NAT-PROD ="11')
        SUM QUANTITE,VALEUR TO Q12,V12 FOR (NAT-PROD ="12')
        SUM QUANTITE,VALEUR TO Q13,V13 FOR (NAT-PROD ="13')
        SUM QUANTITE,VALEUR TO Q14,V14 FOR (NAT-PROD ="14')
        SUM QUANTITE,VALEUR TO Q15,V15 FOR (NAT-PROD ="15')
        SUM QUANTITE,VALEUR TO Q16,V16 FOR (NAT-PROD ="16')
        SUM QUANTITE,VALEUR TO Q17,V17 FOR (NAT-PROD ="17')
        SUM QUANTITE,VALEUR TO Q18,V18 FOR (NAT-PROD ="18')
        SUM QUANTITE,VALEUR TO Q19,V19 FOR (NAT-PROD ="19')
        SUM QUANTITE,VALEUR TO Q20,V20
        DELETE ALL
        PACK
        USE &&closeZip_2

* impression des résultats mensuels.
        SET CONSOLE OFF
        SET PRINT ON
        ?? CHR (15)
? "|"+STR(Tel.3)+" Q "+STR(Q1,8) +STR (Q2,8)+STR(Q3,8)+" | "+STR(Q4,8)+STR(Q5,8);
+STR(Q6,8)+" | "+STR(Q7,8)+STR(Q8,8)+STR(Q9,8)+" | "+STR(Q10,8)+STR(Q11,8);
+" | "+STR(Q12,8)+" | "+STR(Q13,8)+" | "+STR(Q14,8)+" | "+STR(Q15,8)
?? " | "+STR(Q16,8)+" | "+STR(Q17,8)+" | "+STR(Q18,8)+" | "+STR(Q19,8)+" | ";
+STR(Q20,14)+" | "
? "| V"+STR(V1/1000,8)+STR(V2/1000,8)+STR(V3/1000,8)+" | "+STR(V4/1000,8);
+STR(V5/1000,8)+STR(V6/1000,8)+" | "+STR(V7/1000,8)+STR(V8/1000,8);
+STR(V9/1000,8)+" | "+STR(V10/1000,8)+STR(V11/1000,8)+" | "+STR(V12/1000,8)
?? " | "+STR(V13/1000,8)+" | "+STR(V14/1000,8)+" | "+STR(V15/1000,8)+" | ";
+STR(V16/1000,8)+" | "+STR(V17/1000,8)+" | "+STR(V18/1000,8)+" | ";
+STR(V19/1000,8)+" | "+STR(V20/1000,14)+" | "
        DO LINE
        SET PRINT OFF
        STORE Tel + 1 TO Tel
     ENDDO Tel

* calcul et impression des totaux (annuels).
    IF Tel > 12
       DO LINE
       SET CONSOLE OFF
       STORE 0 TO Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12,Q13,Q14,Q15,Q16,Q17
       STORE 0 TO Q18,Q19,Q20,V1,V2,V3,V4,V5,V6,V7,V8,V9,V10,V11,V12,V13,V14
       STORE 0 TO V15,V16,V17,V18,V19,V20
       USE C:ZIP_3
       SUM QUANTITE,VALEUR TO Q1,V1 FOR (NAT-PROD = "01")
       SUM QUANTITE,VALEUR TO Q2,V2 FOR (NAT-PROD = "02")
       SUM QUANTITE,VALEUR TO Q3,V3 FOR (NAT-PROD = "03")
       SUM QUANTITE,VALEUR TO Q4,V4 FOR (NAT-PROD = "04")
       SUM QUANTITE,VALEUR TO Q5,V5 FOR (NAT-PROD = "05")
       SUM QUANTITE,VALEUR TO Q6,V6 FOR (NAT-PROD = "06")
       SUM QUANTITE,VALEUR TO Q7,V7 FOR (NAT-PROD = "07")
       SUM QUANTITE,VALEUR TO Q8,V8 FOR (NAT-PROD = "08")
       SUM QUANTITE,VALEUR TO Q9,V9 FOR (NAT-PROD = "09")
       SUM QUANTITE,VALEUR TO Q10,V10 FOR (NAT-PROD = "10")
       SUM QUANTITE,VALEUR TO Q11,V11 FOR (NAT-PROD = "11")
       SUM QUANTITE,VALEUR TO Q12,V12 FOR (NAT-PROD = "12")
       SUM QUANTITE,VALEUR TO Q13,V13 FOR (NAT-PROD = "13")
       SUM QUANTITE,VALEUR TO Q14,V14 FOR (NAT-PROD = "14")
       SUM QUANTITE,VALEUR TO Q15,V15 FOR (NAT-PROD = "15")
       SUM QUANTITE,VALEUR TO Q16,V16 FOR (NAT-PROD = "16")
       SUM QUANTITE,VALEUR TO Q17,V17 FOR (NAT-PROD = "17")
       SUM QUANTITE,VALEUR TO Q18,V18 FOR (NAT-PROD = "18")
       SUM QUANTITE,VALEUR TO Q19,V19 FOR (NAT-PROD = "19")
       SUM QUANTITE,VALEUR TO Q20,V20
       DELETE ALL
       PACK
       USE &&close

       SET PRINT ON
       ?? CHR(15)
       ? "|TOTAUX"+SPACE(203)+"|"
? "|QUANTI"+STR(Q1,8)+STR(Q2,8)+STR(Q3,8)+" | "+STR(Q4,8)+STR(Q5,8)+STR(Q6,8);
+" | "+STR(Q7,8)+STR(Q8,8)+STR(Q9,8)+" | "+STR(Q10,8)+STR(Q11,8)+" | ";
+STR(Q12,8)+" | "+STR(Q13,8)+" | "+STR(Q14,8)+" | "+STR(Q15,8)+" | "
?? STR(Q16,8)+" | "+STR(Q17,8)+" | "+STR(Q18,8)+" | "+STR(Q19,8)+" | ";
+STR(Q20,14)+" | "
? "|VALEUR"+STR(V1/1000,8)+STR(V2/1000,8)+STR(V3/1000,8)+" | "+STR(V4/1000,8);
+STR(V5/1000,8)+STR(V6/1000,8)+" | "+STR(V7/1000,8)+STR(V8/1000,8);
+STR(V9/1000,8)+" | "+STR(V10/1000,8)+STR(V11/1000,8)+" | "
?? STR(V12/1000,8)+" | "+STR(V13/1000,8)+" | "+STR(V14/1000,8)+" | ";
+STR(V15/1000,8)+" | "+STR(V16/1000,8)+" | "+STR(V17/1000,8)+" | ";
+STR(V18/1000,8)+" | "+STR(V19/1000,8)+" | "+STR(V20/1000,14)+" | "
       SET PRINT OFF
       DO LINE
       SET CONSOLE OFF
       SET PRINT ON
       EJECT
       SET PRINT OFF
    ENDIF &&>12
    STORE .F. TO Process
ELSE

* si le choix est "tous les fivondronana d'un FARITANY".

    IF Fiv ="000'
       USE C:ZIP_2.DBF &&open
       APPEND FROM C:ZIP_3 FOR(FIVONDRON = Y)
       SUM QUANTITE,VALEUR TO Q1,V1 FOR (NAT-PROD ="01')
       SUM QUANTITE,VALEUR TO Q2,V2 FOR (NAT-PROD ="02')
       SUM QUANTITE,VALEUR TO Q3,V3 FOR (NAT-PROD ="03')
       SUM QUANTITE,VALEUR TO Q4,V4 FOR (NAT-PROD ="04')
       SUM QUANTITE,VALEUR TO Q5,V5 FOR (NAT-PROD ="05')
       SUM QUANTITE,VALEUR TO Q6,V6 FOR (NAT-PROD ="06')
       SUM QUANTITE,VALEUR TO Q7,V7 FOR (NAT-PROD ="07')
       SUM QUANTITE,VALEUR TO Q8,V8 FOR (NAT-PROD ="08')
       SUM QUANTITE,VALEUR TO Q9,V9 FOR (NAT-PROD ="09')
       SUM QUANTITE,VALEUR TO Q10,V10 FOR (NAT-PROD ="10')
       SUM QUANTITE,VALEUR TO Q11,V11 FOR (NAT-PROD ="11')
       SUM QUANTITE,VALEUR TO Q12,V12 FOR (NAT-PROD ="12')
       SUM QUANTITE,VALEUR TO Q13,V13 FOR (NAT-PROD ="13')
       SUM QUANTITE,VALEUR TO Q14,V14 FOR (NAT-PROD ="14')
       SUM QUANTITE,VALEUR TO Q15,V15 FOR (NAT-PROD ="15')
       SUM QUANTITE,VALEUR TO Q16,V16 FOR (NAT-PROD ="16')
       SUM QUANTITE,VALEUR TO Q17,V17 FOR (NAT-PROD ="17')
       SUM QUANTITE,VALEUR TO Q18,V18 FOR (NAT-PROD ="18')
       SUM QUANTITE,VALEUR TO Q19,V19 FOR (NAT-PROD ="19')
       SUM QUANTITE,VALEUR TO Q20,V20
       DELETE ALL
       PACK
       USE &&closeZip_2
       SET PRINT ON
       ?? CHR(15)
       DO CHOIX-FIV

* impression des résultats.
       SET PRINT ON
       SET CONSOLE OFF
       ?? CHR(15)
?? "Quant"+STR(Q1,8)+STR(Q2,8)+STR(Q3,8)+" | "+STR(Q4,8)+STR(Q5,8)+STR(Q6,8);
+" | "+STR(Q7,8)+STR(Q8,8)+STR(Q9,8)+" | "+STR(Q10,8)+STR(Q11,8)+" | ";
+STR(Q12,8)+" | "+STR(Q13,8)+" | "+STR(Q14,8)+" | "+STR(Q15,8)+" | ";
?? STR(Q16,8)+" | "+STR(Q17,8)+" | "+STR(Q18,8)+" | "+STR(Q19,8)+" | ";
+STR(Q20,14)+" | "
? "|"+SPACE(14)+"Val."+STR(V1/1000,8)+STR(V2/1000,8)+STR(V3/1000,8)+" | ";
+STR(V4/1000,8)+STR(V5/1000,8)+STR(V6/1000,8)+" | "+STR(V7/1000,8)+STR(V8/1000,8);
+STR(V9/1000,8)+" | "+STR(V10/1000,8)+STR(V11/1000,8)+" | "
?? STR(V12/1000,8)+" | "+STR(V13/1000,8)+" | "+STR(V14/1000,8)+" | ";
+STR(V15/1000,8)+" | "+STR(V16/1000,8)+" | "+STR(V17/1000,8)+" | ";
+STR(V18/1000,8)+" | "+STR(V19/1000,8)+" | "+STR(V20/1000,14)+" |"
       SET PRINT OFF

       STORE STR((VAL (Y)+1),3) TO Y
       IF Far ="1'
          IF y ="110'
             STORE STR ((VAL(Y)+2),3) TO Y
          ENDIF

* arrangement pour terminer la routine.
          IF Y ="120'
             STORE .F. TO Process
          ENDIF
             IF Far ="2'
                IF Y ="210'
                   STORE .F. TO Process
                ENDIF
             ELSE
                IF Far ="3'
                   IF Y ="323'
                      STORE .F. TO Process
                   ENDIF
                ELSE
                   IF Far ="4'
                      IF Y ="422'
                         STORE .F. TO Process
                      ENDIF
                   ELSE
                      IF Far ="5'
                         IF Y ="519'
                            STORE .F. TO Process
                         ENDIF
                      ELSE
                         IF Far ="6'
                            IF Y ="622'
                               STORE .F. TO Process
                            ENDIF
                         ENDIF
                      ENDIF
                   ENDIF
                ENDIF
             ENDIF
          ENDIF
       ENDIF
    ENDIF
 ENDIF
ENDDO Process

* calcul et impression finale hors boucle.
   IF Fiv ="000'
      DO LINE
      SET CONSOLE OFF
STORE 0 TO Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12,Q13,Q14,Q15,Q16,Q17,Q18,Q19
STORE 0 TO Q20,V1,V2,V3,V4,V5,V6,V7,V8,V9,V10,V11,V12,V13,V14,V15,V16,V17,V18
      STORE 0 TO V19,V20
      USE C:ZIP_3
      SUM QUANTITE,VALEUR TO Q1,V1 FOR(NAT-PROD = "01")