Il est rappelé que pour les lacs Alaotra et Mantasoa ainsi que pour les autres plans d'eaux importants, les divers sous-programmes n'ont pas encore été rédigés et que les listings présentés peuvent donc faire référence à des routines encore inexistantes.
*** MENU PRINCIPAL *** LACS ***
EXPEDITION DES PRODUITS HALIEUTIQUES
CERTIFICATS D'ORIGINE ET DE SALUBRITE
(C.O.S. des LACS)
-1- | AJOUTER des données aux fichiers |
-2- | EDITER/LISTER les données d'un fichier |
-3- | Expedition mensuelle (MENU) |
-4- | |
-5- | Préparer une nouvelle disquette |
-6- | COPIE (sauvegarde) des fichiers |
-7- | |
-x- | QUITTER le programme |
Choisissez un nombre ( <X> pour TERMINER) |
Figure 1 : présentation du menu principal.
MENU - ADDITION DONNEES COS | |
-1- | ENTRER 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 marquées du fichier TEMPORAIRE |
…<RETOUR>… au menu précédent… |
Figure 2 : Menu d'addition de données.
Pour quel LAC voulez-vous AJOUTER des données ? | |||
-1- | --> | ITASY | |
-2- | --> | ||
-3- | --> | ||
-4- | --> | ||
-5- | --> | ||
-6- | --> | ||
…<RETOUR>… au menu précédent… |
Figure 3 : menu de sélection des lacs.
CERTIFICATS D'ORIGINE ET DE SALUBRITE | ||
---|---|---|
Numéro de la donnée: | 1 | C.O.S. |
Faritany : | Fivondronana : | |
Nature du produit : | Moyen de conservation : | |
Expediteur : | Destinataire : | |
Quantité : | Valeur : | |
Moyen de transport : | ||
DATE : / / |
Figure 4 : bordereau visuel de la saisie des données.
*** EXPEDITIONS HORS DES PLANS D'EAUX *** | ||
-1- | EXPEDITIONS par NATURE du PRODUIT | |
-2- | ||
-3- | par DESTINATION /NATURE du PRODUIT | |
-4- | ||
-5- | par EXPEDITEUR /NATURE du PRODUIT | |
-6- | ||
-7- | <RETOUR> au menu précédent : |
Figure 5: Menu de traitement des information.
pour quel LAC (codes de 1 à 3) ? | 1 | |
-1- Lac ITASY | ||
-2- Lac MANTASOA | ||
-3- Lac ALAOTRA | ||
à partir de quel MOIS (codes de 01 à 13) ? | ||
mois <13> = résultats annuels | 13 |
Figure 6 : Menu de sélection du plan d'eau et des mois.
*********************************************************************************************
Ce programme traite la saisie et la comilation des CERTIFICATS d'ORIGINE
et de SALUBRITE (COS) émis par les différentes autorités des pêches
dans les divers plans d'eaux intérieurs.
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 PNU/FAO/MAG/85/014 - “Assistance à
l'Administration des Peches et de l'Aquaculture”.
Date de création : 20/01/1988
Version : Numéro - 1 - Date de révision : 17/02/1988
*********************************************************************************************
CLEAR ALL
SET BELL OFF
SET DEFAULT TO C
SET HEADING ON
* SET HELP OFF
SET PATH TO C:\DBASE\LAC
SET CONFIRM ON
SET SAFETY ON
CLEAR
SET TALK OFF
* présentation du menu principal.
STORE .T. TO ReplySTORE SPACE(1) TO Action | |
CLEAR | |
@ 3,10 SAY " | *** MENU PRINCIPAL *** LACS ***" |
@ 4,10 SAY " | EXPEDITION DES PRODUITS HALIEUTIQUES" |
@ 5,10 SAY " | CERTIFICATS D'ORIGINE ET DE SALUBRITE" |
@ 6,10 SAY " | (C.O.S. des LACS)" |
@ 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-" |
@ 14,8 SAY " | -5- Préparer une nouvelle disquette" |
@ 15,8 SAY " | -6- COPIE (sauvegarde) des fichiers" |
@ 16,8 SAY " | -7-" |
@ 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' SET TALK OFF STORE 2 TO Tel DO WHILE Tel < 16 CLEAR @ 10,20 SAY "Vous QUITTER le programme …" ? STORE Tel + 2 TO Tel ENDDO &&Tel<16 CLOSE DATABASES CLEAR ALL QUIT ELSE IF Action ="1' * donne accès au menu pour ajouter de nouvelles données. DO ADD_COS ELSE IF Action ="2' * permet de revoir les données dans un fichier. CLEAR DISPLAY FILES ON A: ? ? 'Quel fichier voulez-vous REVOIR ?' ? "n'oubliez pas d'ajouter <<.DBF>> apres 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 UPPERWAIT ENDIF ELSE IF Action ="3' * donne accès au menu de traitement des données. DO MENU_3 ELSE IF Action ="4' * donne accès au menu de traitement total annuel - pas encore installé. ELSE IF Action ="5' * permet de créer une nouvelle diskette. DO MKFL ELSE IF Action ="6' * permet de faire une copie de sauvegarde de la diskette de données. DO LAC_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 - pas encore installé. ENDIF 7 ENDIF 6 ENDIF 5 ENDIF 4 ENDIF 3 ENDIF 2 ENDIF 1 ENDIF X STORE .T. TO Reply ENDDO Reply * fin du menu principal.
*********************************************************************************************
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 LAC d'origine.
par exemple : COS-ITAS.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 à
totues sortes de problèmes pour corriger les erreurs. Les données
sont par contre saisies sur un fichier intérimaire appleé
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 * Saisie de nouvelles données. IF Act ="1' CLEAR @ 4,10 SAY' VERIFIEZ tous les COS avant la saisie … !!!!' @ 6,10 SAY' VERIFIEZ qu'ils sont complets et corrects …!!!" @ 10,10 SAY' Voulez-vous CONTINUER ? (O/N)' WAIT TO Goahead IF UPPER(Goahead) ="0' 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 LAC voulez-vous AJOUTER des données ?' @ 7,10 SAY ' -1- --> ITASY' @ 8,10 SAY ' -2- --> ' @ 9,10 SAY ' -3- --> ' @ 10,10 SAY ' -4- --> ' @ 11,10 SAY ' -5- --> ' @ 12,10 SAY ' -6- --> ' @ 14,10 SAY ' …<RETOUR>… au menu précédent…' GET Answ @ 3,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 * Edition du fichier temporaire pour vérification des données saisies. IF Act ="2' 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 dans le fichier temporaire." ?' …<RETOUR>… pour continuer …' ? WAIT STORE "N" TO Reviewing ELSE CLEAR ?' Il y a '- STR(ANY,5)+' entrées temporaires,' ?" voulez-vous qu'elles soient IMPRIMEES ? (O/N)" ? WAIT TO Output IF UPPER (Output) ="0' SET PRINT ON ?? CHR(15) ENDIF SET TALK OFF STORE 'OFF' TO Condition STORE 'O' TO Number DO Printout ? ?" Cela sont toutes les entrées temporaires." ?" voulez-vous les revoir ? (O/N)" ?" pour voir les entrées marquées 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 LAC_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) ="O' 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 les lacs.
Un fichier temporaire appelé GETDATA est utilisé 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 ="1' ??' ITASY ***' CASE Answ ="2' ??' ***' CASE Answ ="3' ?? '***' 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="1' .AND..NOT.FILE('A:COS_ITAS.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 * Copiage de la structure du fichier temporaire TEMPFILE 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 données dans le fichier GETDATA et vérification des * informations entrées. STORE 'O' 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 "Valeur : " @ 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) =" ' .OR. 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ées incomplètes, 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 &&pas installé. * 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 EXPEDITEURS, les DESTINATIONS et la
NATURE des PRODUITS des données saisies pour les COS des lacs
en utilisant un fichier GLOB_2. 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 Expéditeurs. GO TOP DO WHILE .NOT. EOF() STORE STR(RECNO(), 5) TO Number STORE UPPER(Expediteur) TO Expediteur CLEAR @ 4,15 SAY " ***** VERIFICATION DES CODES Expéditeur *****" @ 6,15 SAY " Enrégistrement "+Number @ 7,15 SAY " Expéditeur : "+EXPEDITEUR STORE SUBSTR(Expediteur, 1,3) TO Key SELECT 3 USE C:GLOB_2 INDEX C: G2EX_DX FIND &Key STORE .T. TO Again STORE 'T' TO Decision IF (EOF() .OR. BOF()) DO WHILE Again @ 9,10 SAY " Cet EXPEDITEUR 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 EXPEDITEUR REPLACE Expediteur WITH UPPER(Expediteur) SELECT 3 &&Glob_2 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 &&Expéditeur * Vérification des codes des DESTINATIONS. SELECT 2 &&Get USE GETDATA GO TOP DO WHILE .NOT. EOF() STORE STR(RECNO(), 5) to Number STORE UPPER(DESTIN) TO Destin CLEAR @ 4,15 SAY " *** VERIFICATION DES CODES Destination ***" @ 6,15 SAY " Enrégistrement "+Number @ 7,15 SAY " Destination : "+DESTIN STORE SUBSTR(DESTIN,1,3) TO Key SELECT 3 &&Global USE C:GLOB_2 INDEX C:G2DE_DX FIND &Key STORE .T. TO Again STORE 'T' TO Decision IF (EOF() .OR. BOF() ) DO WHILE Again @ 9,10 SAY " Cette DESTINATION 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 DESTINATION REPLACE DESTIN WITH UPPER(DESTIN) SELECT 3 &&Glob_2 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 && Destination * 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 &&Glob_2 USE C:GLOB_2 INDEX C:G2NP_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 REFLACE NAT PROD WITH UPPER(NAT_PROD) SELECT 3 &&Glob_2 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 &&EDF() or BOF() SELECT 2 &&Get IF UPPER(Decision) <> 'E' * IF EOF() * GO TOP * ELSE SKIP * ENDIF ENDIF &&<> 'E' ENDDO nature produit SET TALK ON RELEASE ALL RETURN * Retour au sous-programme ADD_2.
*********************************************************************************************
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 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 doublement copiées.
Finalement, toutes les données sont transférées sur la disquette de
destination.
Durant cette procédure, l'opérateur doit dans la measure du possible tenir
compte d'éventuelles coupures de courant qui risqueraient de détruire
également la base de données originale.
*********************************************************************************************
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- Lac ITASY' @ 12,20 SAY ' -2- Lac MANTASOA' @ 13,20 SAY ' -3- Lac ALAOTRA' @ 14,20 SAY ' -4- ' @ 15,20 SAY ' -5- ' @ 16,20 SAY ' -6- ' @ 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_ITAS.DBF') RELEASE ALL RETURN ENDIF &¬_cos_itas ELSE IF Ant ="2' IF .NOT. FILE ('A:COS_MANT.DBF') RELEASE ALL RETURN ENDIF &¬_cos_mant ELSE IF Ant = "3" IF .NOT. FILE('A:COS_ALAO.DBF') RELEASE ALL RETURN ENDIF &¬_cos_alao ELSE RELEASE ALL CLOSE DATABASES RETURN ENDIF &&Ant=3 ENDIF &&Ant=2 ENDIF &&Ant=1 ENDIF &&Ant=7 * création du fichier choisi sur disque dur. IF Ant ="1' USE A:COS_ITAS.DBF ELSE IF Ant ="2' USE A:COS_MANT.DBF ELSE IF Ant ="3' USE A:COS_ALAO.DBF ELSE RELEASE ALL RETURN ENDIF &&3 ENDIF &&2 ENDIF &&1 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_ITAS.DBF CASE Ant ="2' APPEND FROM A:COS_MANT.DBF CASE Ant ="3' APPEND FROM A:COS_ALAO.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_ITAS.DBF') RELEASE ALL RETURN ENDIF &¬_cos_itas ELSE IF Ant ="2' IF .NOT. FILE('A:COS_MANT.DBF') RELEASE ALL RETURN ENDIF &¬_cos_mant ELSE IF Ant = "3" IF .NOT. FILE('A:COS_ALAO.DBF') RELEASE ALL RETURN ELSE RELEASE ALL RETURN ENDIF &¬_cos_alao ENDIF &&Ant=3 ENDIF &&Ant=2 ENDIF &&Ant=1 * 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_ITAS.DBF CASE Ant ="2' USE A:COS_MANT.DBF CASE Ant ="3' USE A:COS_ALAO.DBF ENDCASE SET SAFETY OFF ZAP USE DO CASE CASE Ant ="1' USE A:COS_ITAS.DBF CASE Ant ="2' USE A:COS_MANT.DBF CASE Ant ="3' USE A:COS_ALAO.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 est ensuite effacé une fois que les enrégistrements
ont été transférés sur le fichier de destination.
*********************************************************************************************
USE * Procédure d'accès au sous-programme. 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- ITASY" @ 8,10 SAY " -2- " @ 9,10 SAY " -3- " @ 10,10 SAY " -4- " @ 11,10 SAY " -5- " @ 12,10 SAY " -6- " @ 14,10 SAY " -7- …<RETOUR>… au menu." @ 15,10 SAY " Choisissez un nombre …" GET Reply @ 4,12 TO 16,66 READ CLEAR @ 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 ="1' USE A:COS_ITAS.DBF ELSE IF Reply ="2' 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 ="3' 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 PACK ENDIF none USE RELEASE ALL RETURN ENDIF lock
*********************************************************************************************
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 quel LAC voulez-vous préparer une nouvelle disquette ?' @ 11,15 SAY ' -1- ITASY' @ 12,15 SAY ' -2- MANTASOA' @ 13,15 SAY ' -3- ALAOTRA' ? ACCEPT' -4- <RETOUR> au menu…' TO Ant IF Ant ="7' RELEASE ALL RETURN ELSE IF (Ant ="1' .OR. Ant="2' .OR. Ant="3') CLEAR @ 10,10 SAY 'INSEREZ la diskette SOURCE (avec les fichiers) …svp…' @ 12,10 SAY ' et taper <RETOUR>' WAIT CLEAR * vérification que la disquette contenant le fichier est bien en a: IF Ant ="1' USE A:COS_ITAS.DBF ELSE IF Ant ="2' USE A:COS_MANT.DBF ELSE IF Ant ="3' USE A:COS_ALAO.DBF ELSE RELEASE ALL RETURN TO MASTER ENDIF &&1 ENDIF &&2 ENDIF &&3 ENDIF &&1…3 ENDIF &&4 * copie du fichier sur disque dur. COPY STRUCTURE TO C:Zip1 USE * copie du fichier du disque dur vers la disquette de destination. @ 10,10 SAY 'INSEREZ la disquette de DESTINATION (VIERGE et FORMATTEE)…svp…' @ 12,10 SAY ' et taper <RETOUR>' WAIT CLEAR USE Zip1 IF Ant ="1' COPY STRUCTURE TO A:COS_ITAS.DBF COPY STRUCTURE TO A:TEMPFILE USE A:COS_ITAS.DBF ELSE IF Ant ="2' COPY STRUCTURE TO A:COS_MANT.DBF COPY STRUCTURE TO A:TEMPFILE USE A:COS_MANT.DBF ELSE IF Ant ="3' COPY STRUCTURE TO A:COS_ALAO.DBF COPY STRUCTURE TO A:TEMPFILE USE A:COS_ALAO.DBF ELSE USE RELEASE ALL RETURN ENDIF 3 ENDIF 2 ENDIF 1 * fin de la procédure de copie de fichier. 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 (+1'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.
*********************************************************************************************
SET HEADING OFF SET SAFETY OFF STORE '0' TO Reviewing DO WHILE UPPER(Reviewing) ="0' COPY STRUCTURE EXTENDED TO Temp GO BOTTOM SET TALK OFF STORE STR(RECNO(),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 imprimé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 ' ARRET à enrégistrement numéro 'GET RecoCnt @ 12,10 SAY ' DEMARRAGE numérotation papier à 'GET PageCnt @ 13,10 SAY ' PAUSER tout les 10 enrégistrements 'GET Pause @ 14,10 SAY ' MONTRER les champs séléctionnés'GET Partial @ 15,10 SAY ' DISPLAY pour expression 'GET Conditions @ 16,10 SAY ' MONTRER numéro enrégistrements 'GET Tally ? ? ' <C> pour CHANGER les valeurs de défault,' ? ' <RETOUR> pour Continuer…' WAIT TO Changing IF UPPER(Changing) ="C' * Clears to end of screen @ 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éro 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 (0/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 * not installed * 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 (0/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 ' *** '+[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 ? "Entrer une ligne d'entête ou presser <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émarre à l'enrégistrement # "-STR(RECNO(),5) ? IF .NOT. (Partial > ' ' .OR. Conditions > ' ') DO Revhdr ENDIF 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 * Inserts a space every ten records, then waits. The printer is turned off so * that "WAIT" does not print on the hardcopy. ? SET PRINT OFF SET TALK ON IF UPPER(Pause) ="0' WAIT ENDIF IF UPPER(Hardcopy) ="0' SET PRINT ON ENDIF * The following routine prints 50 entries to a page, * then moves to the next page and prints a heading. 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. Conditions > ' ') 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 '0' TO Reviewing ENDIF ENDIF ? ENDDO Reviewing USE DELETE FILE Temp.DBF RELEASE ALL RETURN
*********************************************************************************************
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_ITAS.DBF" .OR. UPPER(Database) = "A:COS_ALAO.DBF" SET MARGIN TO 0 ELSE IF UPPER(Database) = "A:COS_MANT.DBF" SET MARGIN TO 0 ENDIF ENDIF RETURN
*********************************************************************************************
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 sont désirés.
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.
*********************************************************************************************
* 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 DES PLANS D'EAUX ***" @ 5,20 SAY " " @ 7,17 SAY "-1- EXPEDITIONS par NATURE du PRODUIT" @ 8,17 SAY "-2- " @ 9,17 SAY "-3- par DESTINATION / NATURE du PRODUIT" @ 10,17 SAY "-4- " @ 11,17 SAY "-5- par EXPEDITEUR / NATURE du PRODUIT" @ 12,17 SAY "-6- " @ 15,17 SAY "-7- <RETOUR> au menu précédent :" GET Reply READ IF Reply ="7' USE RELEASE ALL RETURN ELSE * sélection des paramètres IF (Reply="1' .OR. Reply="3' .OR. Reply="5') STORE SPACE(1) TO Lac STORE SPACE(2) TO Mois CLEAR @ 5,10 SAY "pour quel LAC (codes de 1 à 3) ? " GET Lac @ 6,15 SAY "- 1 - Lac ITASY" @ 7,15 SAY "- 2 - Lac MANTASOA" @ 8,15 SAY "- 3 - Lac ALAOTRA" IF Reply <> '1' @ 10,10 SAY "à partir de quel MOIS (codes de 01 à 13) ?" @ 11,15 SAY "mois <13> = résultats annuels " GET Mois ENDIF @ 2,3 TO 14,73 DOUBLE READ ELSE RELEASE ALL RETURN ENDIF ENDIF CLEAR * vérification des bases de données. La disquette en a: doit avoir les * données du LAC séléctionné. IF Lac ="1' IF .NOT. FILE('A:COS_ITAS.DBF') RELEASE ALL RETURN ENDIF ELSE IF Lac ="2' IF .NOT. FILE('A:COS_MANT.DBF') RELEASE ALL RETURN ENDIF ELSE IF Lac ="3' IF .NOT. FILE('A:COS_ALAO.DBF') RELEASE ALL RETURN ENDIF ELSE RELEASE ALL RETURN ENDIF &&3 ENDIF &&2 ENDIF &&1 * sélection des bases de données à utiliser ultérieurement DO CASE CASE Lac = "1" USE A:COS_ITAS.DBF CASE Far = "2" USE A:COS_MANT.DBF CASE Far = "3" USE A:COS_ALAO.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. DO CASE CASE Lac ="1' APPEND FROM A:COS_ITAS.DBF CASE Lac ="2' APPEND FROM A:COS_MANT.DBF CASE Lac ="3' APPEND FROM A:COS_ALAO.DBF OTHERWISE CLOSE DATABASES DELETE FILE C:ZIPZIP.DBF RETURN ENDCASE * 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 plan d'eau d'origine, * présentation des résultats par nature des produits. DO LA_1_MEN CASE Reply = "2" * expédition mensuelle/annuelle à partir d'un plan d'eau d'origine, * présentation des résultats par moyen de conservation. CASE Reply = "3" * expédition mensuelle/annuelle à partir d'un plan d'eau d'origine, * présentation des résultats par nature des produits et par destination. DO LA_3_MEN CASE Reply = "4" * expédition mensuelle/annuelle à partir d'un plan d'eau d'origine, * présentation des résultats par moyen de conservation et par destination. CASE Reply = "5" * expédition mensuelle/annuelle à partir d'un plan d'eau d'origine, * présentation des résultats par expéditeur et par nature du produit. DO LA_5_MEN CASE Reply = "6" * expédition mensuelle/annuelle à partir d'un plan d'eau d'origine, * présentation des résultats par expéditeur et par moyen de conservation. OTHERWISE RELEASE ALL RETURN ENDCASE STORE .F. TO Check ENDDO Check USE SET SAFETY ON RELEASE ALL RETURN * retour au menu initial.
*********************************************************************************************
Ce programme calcule, par mois ou par année, les expéditions à partir d'un
plan d'eau important, par NATURE DES PRODUITS.
Les données ont été transférées sur disque dur pour raison de sécurité.
*********************************************************************************************
* création de d'un fichier additionnel pour un traitement plus rapide. USE C:Zipzip.DBF COPY STRUCTURE TO C:ZIP_2.DBF USE &&Close * impression de l'entête. STORE '1' TO Part DO SETUP SET PRINT OFF DO LINE SET CONSOLE OFF SET TALK OFF STORE .T. TO Process STORE 1 TO Tel * boucle principale. DO WHILE Process * boucle des mois. 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 * calcul des résultats mensuels. USE C:ZIP_2.DBF &&open APPEND FROM C:ZIPZIP 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 SET CONSOLE OFF * impression des résultats mensuels. SET PRINT ON ?? CHR(15) * quantités. ? "| "+STR(Tel,3)+" Quant |"+STR(Q1,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(Q19,8)+" |"; +STR(Q20,14)+" |" * valeurs. ? "| 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)+" |" DO LINE SET PRINT OFF STORE Tel + 1 TO Tel ENDDO Tel * fin de la boucle des mois. * calcul des résultats 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:ZIPZIP 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 * impression des résultats annuels. SET PRINT ON ?? CHR (15) ? "| TOTAUX"+SPACE(211)+"|" ? "| Quantité |"+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 ENDIF &&>12 STORE .F. TO Process ENDDO Process * fin de la boucle principale. * remise en état et retour au menu. USE DELETE FILE C:ZIP_2.DBF DELETE FILE C:ZIPzip.DBF RELEASE ALL RETURN * retour au menu trois.
*********************************************************************************************
Ce programme calcule, par mois ou par année, les expéditions à partir
d'un plan d'eau des produits et leur destination.
Les données ont été transférées sur disque dur pour raison de sécurité.
Les résultats sont présentés mensuellement par destination ou annuellement
pour toutes les destinations d'un faritany.
Le mois 13 donne les résultats annuels par fivondronana.
*********************************************************************************************
* Création de deux fichiers additionnels pour traitement plus rapide. USE C:Zipzip COPY STRUCTURE TO C:Zip_2.DBF COPY STRUCTURE TO C:ZIP_3.DBF USE * préparation de l'environnement de travail. SET TALK OFF SET CONSOLE OFF STORE VAL(Mois) TO Tel STORE .T. TO Process STORE 1 TO Count STORE '1' TO Part, Boucle * Boucle principale. DO WHILE Process * boucle des mois. DO WHILE Tel < 14 STORE SPACE(2) TO X IF Tel < 10 STORE '0'+STR(Tel,1) TO X ELSE STORE STR(Tel,2) TO X ENDIF STORE '103' TO Y SET CONSOLE ON IF Tel < 13 USE C:Zip_3.DBF APPEND FROM C:Zipzip FOR SUBSTR(DTOC(DATE),4,2) = X ELSE USE C:Zip_3.DBF APPEND FROM C:Zipzip ENDIF INDEX ON Destin+SUBSTR(DTOC(DATE),4,2) TO C:Dein_dx.ndx USE SET CONSOLE OFF * boucle des destinations. DO WHILE Y < '140' CLEAR * impression de l'entête. IF Boucle ="1' DO Setup DO Line ENDIF SET TALK ON SET CONSOLE ON STORE '2' TO Boucle * recherche sur fichier indexé. STORE Y TO Key USE C:Zip_3 INDEX C:Dein_dx FIND &Key IF FOUND() USE C:Zip_2.DBF IF X <> '13' APPEND FROM C:Zip_3 FOR(DESTIN = Y .AND. SUBSTR(DTOC(DATE),4,2) = X) ELSE APPEND FROM C:Zip_3 FOR(DESTIN = Y) ENDIF * calcul des résultats. 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 USE &&close c:zip_3 * impression des résultats. SET PRINT ON ?? CHR(15) ? "| " * sélection des destinations. DO CHX_DES SET PRINT ON SET CONSOLE OFF ?? "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,10)+" |" ? "|"+SPACE(19)+"VI"+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,10)+" |" SET PRINT 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 ENDIF &&Foundkey * visualisation du code de destination sur l'écran. SET TALK ON SET CONSOLE ON STORE STR((VAL(Y)+1),3) TO Y * saut pour le code d'Antsirabe. IF Y ="111' STORE STR((VAL(Y)+1),3) TO Y ENDIF SET TALK OFF SET CONSOLE OFF * impression et calcul des totaux. IF Y ="140' DO LINE SET CONSOLE ON USE C:Zip_2. DBF IF X <> '13' APPEND FROM C:Zip_3 FOR SUBSTR(DTOC(DATE),4,2) = X ELSE APPEND FROM C:Zipzip ENDIF 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 totaux. SET PRINT ON ?? CHR(15) ? "| TOTAUX" ?? " QUANTITE |"+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,10)+" |" ? "|"+SPACE(10)+"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,10)+" |" SET PRINT OFF DO LINE 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 STORE Count + 1 TO Count ENDIF &&YY="140' * fin de boucle destination. ENDDO &&YY<'140' STORE Tel + 1 TO Tel USE C:Zip_3 INDEX C:Dein_dx ZAP USE SET PRINT ON EJECT SET PRINT OFF * préparation à la fermeture de la routine. IF (Tel > 13 .AND. Boucle ="2') STORE Tel + 2 TO Tel STORE .F. TO Process ELSE IF (Tel < 14 .AND. Boucle ="2') STORE '1' TO Boucle STORE 1 TO Count STORE '103' TO Y STORE .T. TO Process ENDIF ENDIF * fin de boucle des mois. ENDDO &&Tel <14 STORE .F. TO Process * fin de boucle principale. ENDDO Process * remise en état de l'environnement de travail. USE DELETE FILE C:Dein_dx.NDX DELETE FILE C:Zip_2.DBF DELETE FILE C:Zipzip.DBF DELETE FILE C:Zip_3.DBF SET TALK ON RELEASE ALL RETURN * retour au menu 3.
*********************************************************************************************
Ce programme calcule, par mois ou par année, les expéditions à partir
d'un plan d'eau des produits et leur destination.
Les données ont été transférées sur disque dur pour raison de sécurité.
Les résultats sont présentés mensuellement ou annuellement par expéditeur
Le mois 13 donne les résultats annuels par expéditeur.
*********************************************************************************************
* Création de deux fichiers additionnels pour traitement plus rapide. USE C:Zipzip COPY STRUCTURE TO C:Zip_2.DBF COPY STRUCTURE TO C:ZIP_3.DBF USE * préparation de l'environnement de travail. SET TALK OFF SET CONSOLE OFF STORE VAL(Mois) TO Tel STORE .T. TO Process STORE 1 TO Count STORE '1' TO Part, Boucle * Boucle principale. DO WHILE Process * boucle des mois. DO WHILE Tel > 14 STORE SPACE(2) TO X IF Tel > 10 STORE '0'+STR(Tel,1) TO X ELSE STORE STR(Tel,2) TO X ENDIF STORE '001' TO Y USE C:Zip_3.DBF IF Tel < 13 APPEND FROM C:Zipzip FOR SUBSTR(DTOC(DATE),4,2) = X ELSE APPEND FROM C:Zipzip ENDIF INDEX ON Expediteur+SUBSTR(DTOC(DATE),4,2) TO C:Expe_dx.ndx USE * boucle des expéditeurs. DO WHILE Y < '122' CLEAR * impression de l'entête. IF Boucle ="1' DO Setup DO Line ENDIF STORE '2' TO Boucle * recherche sur fichier indexé. STORE Y TO Key USE C:Zip_3 INDEX C:Expe_dx FIND &Key IF FOUND() USE C:Zip_2.DBF IF X <> '13' APPEND FROM C:Zip_3 FOR (EXPEDITEUR = Y .AND. SUBSTR(DTOC(DATE),4,2) = X) ELSE APPEND FROM C:Zip_3 FOR(EXPEDITEUR = Y) ENDIF * calcul des résultats mensuels. 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 USE &&close c:zip_3 * impression des résultats mensuels. SET PRINT ON ?? CHR(15) ? "|" * sélection des expéditeurs. DO CHX_EXP SET PRINT ON SET CONSOLE OFF ?? " 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,10)+" |" ? " |"+SPACE(22)+"VI"+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,10)+" |" SET PRINT 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 ENDIF &&Foundkey * visualisation du code des expéditeurs sur l'écran. SET TALK ON SET CONSOLE ON IF Y ="001' STORE STR((Val(Y)+99),3) TO Y ELSE STORE STR((VAL(Y)+1),3) TO Y ENDIF SET TALK OFF SET CONSOLE OFF * impression et calcul des totaux. IF Y ="122' DO LINE USE C:Zip_2.DBF IF X <> '13' APPEND FROM C:Zip_3 FOR SUBSTR(DTOC(DATE), 4,2) = X ELSE APPEND FROM C:Zipzip ENDIF 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 totaux. SET PRINT ON ?? CHR(15) ? "| TOTAUX" ?? " QUANTITE |"+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,10)+" |" ? " |"+SPACE(13)+"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,10)+" |" SET PRINT OFF DO LINE 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 STORE Count + 1 TO Count ENDIF &&YY="122' * fin de boucle expéditeur. ENDDO &&YY<'122' STORE Tel + 1 TO Tel USE C:Zip_3 INDEX C: Expe_dx ZAP USE SET PRINT ON EJECT SET PRINT OFF * préparation à la fermeture de la routine. IF (Tel > 13 .AND. Boucle ="2') STORE Tel + 2 TO Tel STORE .F. TO Process ELSE IF (Tel < 14 .AND. Boucle ="2') STORE '1' TO Boucle STORE 1 TO Count STORE '100' TO Y STORE .T. TO Process ENDIF ENDIF * fin de boucle des mois. ENDDO &&Tel<14 STORE .F. TO Process * fin de boucle principale. ENDDO Process * remise en état de l'environnement de travail. USE DELETE FILE C:Expe_dx. NDX DELETE FILE C:Zip_2. DBF DELETE FILE C:Zipzip. DBF DELETE FILE C:Zip_3. DBF SET TALK ON RELEASE ALL RETURN * retour au menu 3.
*********************************************************************************************
Ce programme imprime l'entête pour les estimations mensuelles des
expéditions hors d'un plan d'eau inportants.
*********************************************************************************************
SET PRINT OFF SET TALK OFF SET CONSOLE OFF STORE DATE() TO Mdate SET PRINT ON IF Part ="1' SET PRINT ON SET MARGIN TO 0 ?? CHR(18) &&normal printing mode ?? CHR(27) + CHR(88) + CHR(2) + CHR(232) ? SPACE (37)+ 'MINISTERE DE LA PRODUCTION ANIMALE ET DES EAUX ET FORETS.' ? ? "REPUBLIQUE DEMOCRATIQUE"+SPACE(21)+"DIRECTION DE LA PECHE ET DE" ?? "L'AQUACULTURE." ? SPACE (6)+ "DE MADAGASCAR" ? ? CHR(14) ?? SPACE(9)+"EXPEDITIONS à partir DU LAC" DO CASE CASE Lac ="1' ?? " ITASY - 1987 -" CASE Lac ="2' ?? "MANTASOA - 1987 -" CASE Lac ="3' ?? "ALAOTRA - 1987 -" ENDCASE ?? CHR(15) ? ? "Date : "+DTOC(Mdate) ?? CHR(18) ENDIF SET PRINT ON ?? CHR(15) IF Reply ="1' ?? SPACE(153) ELSE IF Reply ="3' ?? SPACE(156) ELSE IF Reply ="5' ?? SPACE(157) ELSE ENDIF ENDIF ENDIF ??"UNITES Poids : Kgs UNITES Valeur : × 1000 FMG" ?? CHR(18) SET PRINT OFF DO LINE SET PRINT ON DO CASE CASE Reply ="1' ? SPACE(9) ?? CHR(27) + CHR(69) ?? SPACE(23)+ '***** N A T U R E ***** D E S ***** '; +' P R O D U I T S *****' ?? CHR(27) + CHR(70) ?? CHR(15) DO LINE SET PRINT ON ?? CHR(15) ?" | MOIS | Carpe | Fibata | Tilapia | Bl.Bass | C.Dorée | Anguille"; +" | Crabe | | | Autres | N.défini| | |"; +" | | | | | | T O T A L |" ?? CHR(18) CASE Reply ="2' CASE Reply ="3' SET CONSOLE OFF SET PRINT ON ?? CHR(18) ?? CHR(27) + CHR(69) ?' **** PAR **** NATURE **** DES **** PRODU'; +"I T S **** PAR **** DESTINATION ****" ?? CHR(27) + CHR(70) ?? CHR(15) DO Line SET PRINT ON ?? CHR(15) IF Tel > 12 ? "| Destination / Année | Carpe | Fibata | Tilapia | Bl.Bass | C.Dorée | "; +"Anguille | Crabe | | | Autres |N.défini | | "; +" | | | | | | |" ??"T O T A L |" ELSE ? "| Destination /" DO CASE CASE Tel = 1 ?? "Janv." CASE Tel = 2 ?? "Févr." CASE Tel = 3 ?? " Mars " CASE Tel = 4 ?? " Avri " CASE Tel = 5 ?? " Mai " CASE Tel = 6 ?? " Juin " CASE Tel = 7 ?? " Juil. " CASE Tel = 8 ?? " Août " CASE Tel = 9 ?? " Sept. " CASE Tel = 10 ?? " Oct. " CASE Tel = 11 ?? " Nov. " CASE Tel = 12 ?? " Dec. " ENDCASE ?? "| Carpe | Fibata | Tilapia | Bl.Bass | C. Dorée |Anguille"; +"| Crabe | | | Autres |N.défini | | +" | | | | | | TOTAL |" ENDIF CASE Reply ="4' CASE Reply ="5' SET CONSOLE OFF SET PRINT ON ?? CHR(18) ?? CHR(27) + CHR(69) ?' **** PAR **** NATURE **** DES **** PRODU'; +"ITS **** PAR **** EXPEDITEUR ****" ?? CHR(27) + CHR(70) ?? CHR(15) DO Line SET PRINT ON ?? CHR(15) IF Tel > 12 ? "| Expéditeur / Année | Carpe | Fibata | Tilapia | Bl.Bass | C.Dorée |"; +"Anguille | Crabe | | | Autres |N.défini | |"; +" | | | | | | |" ?? " T O T A L |" ELSE ? " | Expéditeur / " DO CASE CASE Tel = 1 ?? " Janv." CASE Tel = 2 ?? " Févr." CASE Tel = 3 ?? " Mars " CASE Tel = 4 ?? " Avri." CASE Tel = 5 ?? " Mai " CASE Tel = 6 ?? " Juin " CASE Tel = 7 ?? " Juil." CASE Tel = 8 ?? " Août " CASE Tel = 9 ?? " Sept." CASE Tel = 10 ?? " Oct. " CASE Tel = 11 ?? " Nov. " CASE Tel = 12 ?? " Déc. " ENDCASE ?? "| Carpe | Fibata | Tilapia | Bl.Bass | C. Dorée |Anguille"; +" | Crabe | | | Autres |N.défini | | | "; +" | | | | | | TOTAL |" ENDIF CASE Reply ="6' ENDCASE SET PRINT OFF SET CONSOLE OFF RETURN
*********************************************************************************************
Ce programme permet la sélection des expéditeurs du lac Itasy.
*********************************************************************************************
SET PRINT ON SET CONSOLE ON SET TALK ON DO CASE CASE Y ="001' ?? "Particuliers " CASE Y ="100' ?? "Mr. Randria A. " CASE Y ="101' ?? "Mr. Rakotondramialy " CASE Y ="102' ?? "Mr. Rakotomandiaby " CASE Y ="103' ?? "Mr. Rakotondrazanany " CASE Y ="104' ?? "Mr. Randrianasolo " CASE Y ="105' ?? "Mr. Rakoto " CASE Y ="106' ?? "Mr. Rakotomandimby " CASE Y ="107' ?? "Mr. Rainimanahirana " CASE Y ="108' ?? "Mr. Rakotondrabe " CASE Y ="109' ?? "Mr. Ranaivoson " CASE Y ="110' ?? "Mr. Rafahatelo " CASE Y ="111' ?? "Mr. Rakotondravao " CASE Y ="112' ?? "Mr. Rakotondrazafy " CASE Y ="113' ?? "Mr. Rakotomananandro " CASE Y ="114' ?? "Mr. Rakotoniaina " CASE Y ="115' ?? "Mr. Razafimahefa " CASE Y ="116' ?? "Mr. Ranaivo " CASE Y ="117' ?? "Mr. Rakotondrahanja " CASE Y ="118' ?? "Mr. Randriambololona " CASE Y ="119' ?? "Mr. Razafimahefa " CASE Y ="120' ?? "Mr. Rasoloarimanga " CASE Y ="121' ?? "Mr. Rakotoasimbola " ENDCASE SET PRINT OFF RETURN * retour au programme appelant.
*********************************************************************************************
Ce programme permet la sélection des destinations.
*********************************************************************************************
SET PRINT ON SET CONSOLE ON SET TALK ON DO CASE CASE Y ="103' ?? "ANTANANARIVO" CASE Y ="104' ?? "AMBATOLAMPY" CASE Y ="105' ?? "AMBOHIDRATRIMO" CASE Y ="106' ?? "ANDRAMASINA" CASE Y ="107' ?? "ANJOZOROBE" CASE Y ="108' ?? "ANKAZOBE" CASE Y ="109' ?? "ANTANIFOTSY" CASE Y ="110' ?? "ANTSIRABE" CASE Y ="112' ?? "ARIVONIMAMO" CASE Y ="113' ?? "BETAFO" CASE Y ="114' ?? "FARATSIHO" CASE Y ="115' ?? "FENOARIV-BE" CASE Y ="116' ?? "MANJAKANDRIANA" CASE Y ="117' ?? "MIARINARIVO" CASE Y ="118' ?? "SOAVINANDRIANA" CASE Y ="119' ?? "TSIROANOMANDIDY" CASE Y ="120' ?? "ANALAVORY" CASE Y ="121' ?? "TSIDIDY" CASE Y ="122' ?? "AMPEFY" CASE Y ="123' ?? "ANKONABE" CASE Y ="124' ?? "AMBATOMANJAKA" CASE Y ="125' ?? "ANKADINONDRY" CASE Y ="126' ?? "IMERINTSIATOSIKA" CASE Y ="127' ?? "ANTANETIMBOAHANGY" CASE Y ="128' ?? "AMPARY" CASE Y ="129' ?? "MAHASOLO" CASE Y ="130' ?? "MANAZARY" CASE Y ="131' ?? "MAHAVELONA" CASE Y ="132' ?? "SOAMAHAMAVINA" CASE Y ="133' ?? "TSINJOARIVO" CASE Y ="134' ?? "MORATSIAZO" CASE Y ="135' ?? "ANTOBY" CASE Y ="136' ?? "MANDIAVATO" CASE Y ="137' ?? "AUTRES DESTINAT." ENDCASE SET PRINT OFF RETURN * retour au programme appelant.
*********************************************************************************************
Ce programme crée une ligne pour le programme des COS des LACS.
*********************************************************************************************
SET PRINT ON SET CONSOLE OFF ?? CHR(15) IF Reply = "2" IF Fiv <> '000' IF Part <> '2' ? "|" ?? REPLICATE("--",110) ELSE IF Part = "2" ? SPACE(25) ?? "|" ?? REPLICATE("--",72) ENDIF ENDIF ELSE &&if fiv="000' IF Part <> '2' ? "|" ?? REPLICATE("--",114) ELSE IF Part = "2" ? SPACE(25) ?? "|" ?? REPLICATE("--",72) ENDIF ENDIF ENDIF ELSE IF Reply = "1" ? "|" ?? REPLICATE("-",218) ELSE IF Reply = "3" ? "|" ?? REPLICATE("-",222) ELSE IF (Reply = "4" .OR. Reply = "6") IF Part <> '2' ? "|" ?? REPLICATE("-",204) ELSE IF Part ="2' ? "|" ?? REPLICATE("-",188) ENDIF ENDIF ELSE IF Reply ="7' ? "|" ?? REPLICATE("-",224) ELSE IF Reply ="5' ? "|" ?? REPLICATE("-",225) ENDIF &&Reply=5 ENDIF &&Reply=7 ENDIF &&Reply=4,6 ENDIF &&Reply=3,5 ENDIF &&Reply=1 ENDIF &&Reply=2 ?? "|" ?? CHR(18) SET PRINT OFF RETURN