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 Reply| STORE 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 UPPER
WAIT
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
