TABLEAU 1.
LISTE DES PRODUITS ET LEUR CODIFICATION.
GROUPE D'ESPECE | CONDITIONNEMENT | MODE DE CONSERVATION | ||
---|---|---|---|---|
POISSONS | entier | -01- | congélation | -01- |
cuisson | -02- | |||
fumage/salage | -03- | |||
éviscéré | -02- | congélation | -04- | |
cuisson | -05- | |||
fumage | -06- | |||
séchage | -07- | |||
fileté | -03- | congélation | -08- | |
fumage | -09- | |||
séchage | -10- | |||
CREVETTES/ | entier | -04- | congélation | -11- |
CAMARONS | cuisson | -12- | ||
séchage | -13- | |||
étêté | -05- | congélation | -14- | |
cuisson | -15- | |||
séchage | -16- | |||
décortiqué | -06- | cuisson | -17- | |
séchage | -18- | |||
CRABES | entier | -07- | vivant/congél. | -19- |
cuisson | -20- | |||
morceau | -08- | congélation | -21- | |
décortiqué | -09- | congélation | -22- | |
LANGOUSTES | entier | -10- | vivant | -23- |
congélation | -24- | |||
cuisson | -25- | |||
queue | -11- | congélation | -26- | |
CEPHALOPODES | entier | -12- | congélation | -27- |
fumage | -28- | |||
séchage | -29- | |||
CHEVAQUINES | entier | -13- | séchage | -30- |
ALGUES | -14- | séchage | -31- | |
TREPANG | -15- | séchage | -32- | |
BICHIQUE | entier | -16- | congélation séchage | -33- -34- |
MOLLUSQUES | -17- | -35- | ||
AILERONS REQUIN | -18- | séchage | -36- | |
AUTRES | -19- | -37- |
MENU - ADDITION DONNEES DOS |
-1- ENTER nouvelles données |
-2- EDITER le fichier TEMPORAIRE |
-3- REVOIR/IMPRIMER le fichier TEMPORAIRE |
-4- MISE A JOUR du fichier de DESTINATION |
-5- EFFACER données parcuées du fichier TEMPORAIRE …<RETOUR>… au menu précédent… |
Figure 3
EXPEDITIONS HORS FIVONDRONANA | ||
-1- | EXPEDITIONS | par NATURE du PRODUIT |
-2- | par MOYEN de CONSERVATION | |
-3- | par DESTINATION / NATURE du PRODUIT | |
-4- | par DESTINATION / MOYEN DE CONSERVATION | |
-5- | par EXPEDITEUR / par NATURE du PRODUIT | |
-6- | EXPORTATIONS | par DESTINATION / MOYEN de CONSERVATION |
-7- | par EXPEDITEUR / NATURE des PRODUITS | |
-8- | <RETOUR> au menu précédent : |
Figure 4
TOTAL ANNUEL - EXPEDITION hors FARITANY | |||
-1- | EXPEDITIONS | par NATURE du PRODUIT | |
-2- | par MOYEN de CONSERVATION | ||
-3- | par DESTINATION (Fivondronana) | ||
Frapper d'abord <9> si vous passez des expéditions aux exportations ! | |||
-5- | EXPORTATIONS | par NATURE du PRODUIT | |
-6- | par MOYEN DE CONSERVATION | ||
-7- | par DESTINATION (pays enrangers) | ||
-8- | PRIX MOYENS au pile par PRODUIT / FIVONDRONANA | ||
-9- | <RETOUR> au menu précédent : |
Figure 5
CERTIFICATS D'ORIGINE ET DE SALUBRITE | |
Korére de la donnés : 1 | C.O.S. |
Faritany : 05 | Fivondronana : 502 |
Nature du produit : 01 | Moyen de conservation : 01 |
Expenditeur : 500 | Destinataire : 103 |
Quantité: 10E.00 | Valeur : 10253 |
Moyen de transport : 02 | |
DATE : 01/02/87 |
<C> pour Chenger,
<F> pour Finir la saisie,
<RETOUR> pour Continuer,
Figure 1
*** MENU PRINCIPAL *** |
EXPEDITION DES PRODUITS HALIEUTIOUES |
CERTIFICATS D'ORIGINE ET DE SALUBRITE |
(C.O.S.) |
-1- | AJOUTER des données aux fichiers |
-2- | EDITER/LISTER les données d'un fichier |
-3- | Expedition pensuelle (MENU) |
-4- | Expedition TOTALE annuelle (MENU) |
-5- | Préparer une nouveile disquette |
-6- | COPIE (sauvegarde) des fichiers |
-7- | AJUSTERENT des PRIX |
-8- | QUITTER le programme |
Chnisisses un noabre (x) peur TERMINER |
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
******************************************************************************************
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.
*********************************************************************************************
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.
********************************************************************************************
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.
************************************************************************************************
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.
**********************************************************************************************
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 &¬-cos-anta ELSE IF Ant ="2' IF .NOT. FILE('A:COS-ANTS.DBF') RELEASE ALL RETURN ENDIF &¬_cos_ants ELSE IF Ant ="3' IF .NOT. FILE('A:COS_FIAN.DBF') RELEASE ALL RETURN ENDIF &¬_cos_fien ELSE IF Ant ="4' IF .NOT. FILE('A:COS_MAHA.DBF') RELEASE ALL RETURN ENDIF &¬-cos-maha ELSE IF Ant ="5' IF .NOT. FILE('A:COS_TOAM.DBF') RELEASE ALL RETURN ENDIF &¬_cos_toam ELSE IF Ant ="6' IF .NOT. FILE('A:COS_TULE.DBF') RELEASE ALL RETURN ENDIF &¬-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 &¬-cos-anta ELSE IF Ant ="2' IF .NOT. FILE('A:COS_ANTS.DBF') RELEASE ALL RETURN ENDIF &¬_cos_anta ELSE IF Ant ="3' IF .NOT. FILE('A:COS_FIAN.DBF') RELEASE ALL RETURN ENDIF &¬_cos_fian ELSE IF Ant ="4' IF .NOT. FILE('A:COS_MAHA.DBF') RELEASE ALL RETURN ENDIF &¬_cos_maha ELSE IF Ant ="5' IF .NOT. FILE('A:COS_TOAM.DBF') RELEASE ALL RETURN ENDIF &¬_cos_toam ELSE IF Ant ="6' IF .NOT. FILE('A:COS_TULE.DBF') RELEASE ALL RETURN ENDIF &¬_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.
***********************************************************************************
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.
******************************************************************************************
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.
***********************************************************************************************
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.
******************************************************************************************
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
*********************************************************************************************
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
*********************************************************
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
************************************************************************************************
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.
***********************************************************************************************
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")