H********************************************************************** * FICHIER CREE PAR zAYEL * CREER LE 02/09/2003 * MODIFIER LE * NOM PROG ORIGINE : selaro3r * NOM PROG ACTUEL : * MANAGER : H********************************************************************** hoption(*nodebugio) H********************************************************************** ffourtout if e k disk fslarsu if e k disk fsoucomlm if e k disk fslarpy if e k disk ffan100p1 if e k disk fslarap uf a e k disk fprodui if e k disk frobttt if e k disk fsouclt if e k disk fstocks if e k disk fslobse uf a e k disk fslobec uf a e k disk fslobve uf a e k disk fslwork uf e k disk fslardv uf e k disk fslpare uf a e k disk fslparel1 if e k disk RENAME(slparef1:slpareF6) fslparel2 uf e k disk RENAME(slparef1:slpareF7) Fslwork1d CF E WORKSTN F SFILE(DETAILFE:ligne0) F SFILE(sflstatu:ligne1) F SFILE(sflfam:ligne2) F SFILE(sflechan:ligne3) F SFILE(sflechan2:ligne3) F SFILE(sflvendu:ligne4) F SFILE(sflvendu2:ligne4) F SFILE(sflparen:ligne5) F SFILE(sflappli:ligne6) F SFILE(sflappli2:ligne6) F SFILE(sflsupport:ligne7) F SFILE(lstsupport:ligne8) F SFILE(lstpays:ligne9) F SFILE(lststatut:ligne10) F SFILE(lstepay:ligne11) F SFILE(lstesoc:ligne12) F SFILE(lstvpay:ligne13) F SFILE(lstvsoc:ligne14) F SFILE(lstfam:ligne15) F SFILE(lstappl:ligne16) C********************************************************************** * * Variable pour Gerere les anomalies : DTblAno s 79 DIM(10) CTDATA PERRCD(1) D DS D LIBANO 01 79 D GOA 68 68 D LLL 72 73 D PPP 74 75 * d* Declaration des variables de type variant * Variable pour expression sql : ds s 500a varying dt s 500a varying dx s 500a varying * dVariable s 52a varying dVariable2 s 52a varying * * Variable pour fichier selection : dvcrSelect s 3a varying dvcrRefDef s 6a varying dvcrAppel1 s 52a varying dvcrContre s 52a varying dvcrNotes1 s 52a varying * * Variable pour fichier legislation : dvcrCouleu s 3a varying dvcrAspect s 3a varying dvcrKasher s 3a varying dvcr50k s 3a varying dvcr50kcod1 s 3a varying dvcr50kcod2 s 3a varying dvcrHallal s 3a varying dvcr50h s 3a varying dvcr50hcod1 s 3a varying dvcr50hcod2 s 3a varying dvcrAllerg s 3a varying dvcrOgm s 3a varying dvcrSupport s 5a varying dvcrColorant s 3a varying * dvcrLegis s 9a varying * dvcrEcla s 8a varying * * Variable pour fichier Produit : dvcrPrixRe s 10a varying * * Variable pour fichier Echantillon : dvcreCodSoc s 50a varying dvcreCodPay s 50a varying dvcreAnnee s 6a varying * * Variable pour fichier Ordres : dvcrvCodSoc s 50a varying dvcrvCodPay s 50a varying dvcrvAnnee s 6a varying * * Variable pour Recherche soci‚t‚ sur nom dveCherchSoc s 20a varying dvvCherchSoc s 20a varying * dvFamille s 5a varying dvProfil s 52a varying * * Variable pour MAP pour traitement des parents : dtbl1 s 6 dim(100) * * Variable pour transfert sql dans tableau ventes : dan s 2 0 dim(1000) dpays s 3 dim(1000) dclient s 8 dim(1000) dqte s 9 3 dim(1000) * * Variable pour Recherche de codes applications : dvCherchApp s 20a varying C********************************************************************** c *entry plist c parm usr1 10 c movel usr1 kusr 10 C********************************************************************** * Recherche observation perso sur fiche arome C recobs KLIST C KFLD kid 6 C KFLD kusr 10 c movel usr1 kusr C********************************************************************** * Recherches diverses dans fourtout c recenr klist c kfld kpos 2 c kfld kcle 10 C********************************************************************** * Recherches Client dans ROBTTT c recclt klist c kfld ste1 5 0 c kfld seq 6 c kfld aux c z-add 1 ste1 c move 'CLIENT' seq C********************************************************************** * Recherches Client dans souclt (Echantillon) c recsouclt klist c kfld ste2 1 c kfld codclt c move '1' ste2 C********************************************************************** * Recherches dans le fichier applications c recappli klist c kfld pro 6 c kfld appli 2 c move *blank pro c move *blank appli C********************************************************************** * Recherches libell‚ pays dans le fichier fan100p1 c recpays klist c kfld soc 5 0 c kfld cod 2 c kfld rarg c z-add 1 soc c move 'PY' cod C********************************************************************** * Recherches dans le fichier logique slparel2 (parent) * utilis‚ pour maj (d‚placement enfants en cas de changement de grp) * utilis‚ pour suppression des enfants si suppression d'un parent c rec klist c kfld ecref 6 c kfld ecgrp 6 0 C********************************************************************** * Recherches Des Echantillons pour une r‚f‚rence c recsou klist c kfld ksoc 1 c kfld kcdp 1 c kfld kcda 3 0 c kfld kcd1 5 0 c kfld kcd2 2 0 c kfld kseq 3 0 C********************************************************************** * Recherches Observations sur les vendus c recobsve klist c kfld kref 6 c kfld kan 2 0 c kfld kpays 3 c kfld kclt 8 c c* ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * * CRITERES * c*==================================================================== c* Affichage de l'‚cran de critŠres *********************************** c*==================================================================== c z-add 3 craspe c crit tag c* RAZ * c z-add 0 nbarom c move *blank Inconnu1 c move *blank Inconnu2 c movel *blank crlibsupp c movel *blank crlibpays c movel *blank crlibstatu c movel *blank codclt c* movel *blank crelibsoc c* movel *blank crelibpay c* movel *blank crvlibsoc c* movel *blank crvlibpay c move *blank crlibfam c move *blank vcrecla c move *blank vcrprixre c clear vcrecla c clear vcrprixre c move *blank ecmsgerr c move *blank EcValid c* RAZ - fin * Recherche du libell‚ Produit c crrefdef ifne *blank c crrefdef chain produif1 99 c *in99 ifeq '0' c move *blank crappel1 c movel prdes crappel1 c else c move *blank crappel1 c move 'Inconnu' crappel1 c endif c endif * - rouge si remplac‚ (pas type 0 1 ou 3 ) ou inconnu c crrefdef ifne *blank c crrefdef chain slworkf1 99 c *in99 ifeq '0' c move '0' *in10 c move '1' RetourCrit 1 c move crrefdef ecrefdef C MOVE *BLANK LIBANO C MOVE *BLANK CRMsgErr c goto afffiche c else c move '1' *in10 c endif c endif * - rouge si remplac‚ (pas type 0 1 ou 3 ) ou inconnu - fin * Recherche du libell‚ Produit - fin * * Recherche du libell‚ Support c crsupport ifne *blank c movel '58' kpos c move crsupport kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel fozon1 crlibsupp c else c move 'Inconnu' crlibsupp c endif c endif * Recherche du libell‚ Support - fin * * Recherche du libell‚ Pays - Legislation c crpays ifne *blank c movel '55' kpos c move crpays kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel fozon1 crlibpays c else c move 'Inconnu' crlibpays c endif c endif * Recherche du libell‚ Pays - fin * * Recherche du libell‚ Statut Legislation pays c crstatut ifne *blank c movel '56' kpos c move crstatut kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel fozon1 crlibstatu c else c move 'Inconnu' crlibstatu c endif c endif * Recherche du libell‚ Statut Legislation pays - fin * * Recherche du libell‚ Societe echantillons c eval vcrecodsoc = %trim(crecodsoc) * - recherche dans souclt c crecodsoc ifne *blank c move vcrecodsoc codclt 8 c recsouclt chain soucltf1 99 c *in99 ifeq '0' c movel clnom crelibsoc c else c move '1' Inconnu1 c endif c endif * - recherche dans souclt - fin c * - recherche dans robttt c Inconnu1 ifeq '1' c move '00000000' aux c move vcrecodsoc aux c recclt chain robtttf1 99 c *in99 ifeq '0' * - enlŠve les zeros pour l'affichage c movel tkaux caract1 1 c movel tkaux caract2 2 c movel tkaux caract3 3 c movel tkaux caract4 4 c movel tkaux caract5 5 c movel tkaux caract6 6 c movel tkaux caract7 7 c caract1 ifeq '0' c movel ' ' crecodsoc c endif c caract2 ifeq '00' c movel ' ' crecodsoc c endif c caract3 ifeq '000' c movel ' ' crecodsoc c endif c caract4 ifeq '0000' c movel ' ' crecodsoc c endif c caract5 ifeq '00000' c movel ' ' crecodsoc c endif c caract6 ifeq '000000' c movel ' ' crecodsoc c endif c caract7 ifeq '0000000' c movel ' ' crecodsoc c endif * - enlŠve les zeros pour l'affichage - fin c movel tknom crelibsoc c else c movel '1' Inconnu2 1 c endif c endif * - recherche dans robttt - fin c c inconnu1 ifeq '1' c inconnu2 andeq '1' c move 'Inconnu' crelibsoc c endif * Recherche du libell‚ Societe echantillons - fin * * Recherche du libell‚ Pays Echantillons c crecodpay ifne *blank c move *blank rarg c movel crecodpay rarg c recpays chain fan100f1 99 c *in99 ifeq '0' c movel tlib1 crelibpay c else c move 'Inconnu' crelibpay c endif c endif * Recherche du libell‚ Pays Echantillons - fin * * Recherche du libell‚ Societe Vendu c eval vcrvcodsoc = %trim(crvcodsoc) c crvcodsoc ifne *blank c move '00000000' aux 8 c move vcrvcodsoc aux * - recherche dans robttt c recclt chain robtttf1 99 c *in99 ifeq '0' c movel tknom crvlibsoc c else c move 'Inconnu' crvlibsoc c endif c endif * - recherche dans robttt - fin c c * Recherche du libell‚ Societe Vendu - fin * * Recherche du libell‚ Pays Vendu c crvcodpay ifne *blank c move *blank rarg c movel crvcodpay rarg c recpays chain fan100p1 99 c *in99 ifeq '0' c movel tlib1 crvlibpay c else c move 'Inconnu' crvlibpay c endif c endif * Recherche du libell‚ Pays Vendu - fin * * Recherche du libell‚ Famille c crcodfam ifne *blank c movel '44' kpos c move crcodfam kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel fozon1 crlibfam c else c move 'Inconnu' crlibfam c endif c endif * Recherche du libell‚ Famille - Fin * * - Remet le num‚ro du produit pr‚c‚damment saisi sur l'‚cran * critŠre si je l'avais saisi c RetourCrit ifeq '1' c move *blank RetourCrit c move *blank CrAppel1 c goto crit c endif * c exfmt criteres * * bouton RAZ CritŠres c *in02 ifeq '1' c pshbtn2 oreq 2 c move *blank ctl1 c move *blank ctl2 c move *blank ctla c move *blank ctlb c move *blank ctlc c move *blank ctld c move *blank ctle c move *blank ctlf c move *blank ctlg c move *blank ctlh c z-add 3 craspe c move *blank crrefdef c move *blank crappel1 c move *blank crappel1 c move *blank crcontre c move *blank crnotes1 c move *blank crcodfam c move *blank crapprouve c move *blank crprofil c move *blank crpays c move *blank crstatut c move *blank crsupport c move *blank crvcodsoc c move *blank crvcodpay c movel *blank crelibsoc c movel *blank crelibpay c movel *blank crvlibsoc c movel *blank crvlibpay c move *blank crvannee c move *blank crecodsoc c move *blank crecodpay c move *blank creannee c z-add *zeros crecla c z-add *zeros crprixre c move *blank ecmsgerr c goto crit c endif * * bouton Quitter c *in03 ifeq '1' c pshbtn3 oreq 3 c goto fin c endif * * bouton solvant/support c pshbtn4 ifeq 4 C EXSR lstsupp c goto fin c endif * * bouton pays c pshbtn5 ifeq 5 C EXSR listpays c goto fin c endif * * bouton statut legislations pays c pshbtn6 ifeq 6 C EXSR liststatut c goto fin c endif * * bouton Soci‚t‚ Echantillon c pshbtn7 ifeq 7 C EXSR listEsoc c goto fin c endif * * bouton Echantillon pays c pshbtn8 ifeq 8 C EXSR listEPays c goto fin c endif * * bouton Soci‚t‚ Vendu c pshbtn10 ifeq 10 C EXSR listVsoc c goto fin c endif * * bouton Vendu pays c pshbtn11 ifeq 11 C EXSR listVPays c goto fin c endif * * bouton Famille c pshbtn12 ifeq 12 C EXSR listFamille c goto fin c endif * c *in09 ifeq '1' c pshbtn9 oreq 9 c goto recherch c else c goto crit c endif * * * * * * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * * * SousFichier * * * FENETRE RESULTAT DE LA RECHERCHE * c*==================================================================== c* Affichage du sous fichier fenŠtre E ******************************** c*==================================================================== c recherch tag * * Analyse l'ecran Criteres en vue de la redactions du texte SQL * R‚f‚rence : c crrefdef ifeq *blank c eval vcrrefdef = '%%' c else c eval vcrrefdef = crrefdef c endif * Appellation : c eval vcrappel1 ='%' + %trim(crappel1) + '%' * Contre type : c eval vcrcontre ='%' + %trim(crcontre) + '%' * Notes/Commentaire : c eval vcrnotes1 ='%' + %trim(crnotes1) + '%' * * Couleur : c ctlg ifeq 1 c eval vcrcouleu = 'INC' c else c eval vcrcouleu = '%%' c endif * * Colorant : c ctlh ifeq 1 c eval vcrColorant = 'O' c else c eval vcrColorant = '%%' c endif * * aspect : c craspe ifeq 1 c eval vcraspect = 'L%' c else c craspe ifeq 2 c eval vcraspect = 'P%' c else c eval vcraspect = '%%' c endif c endif * * Statut religieux : - Kasher - que certifi‚ c ctla ifeq 1 c ctlb andne 1 c eval vcrkasher= '50K' c eval vcr50kcod1= '1' c eval vcr50kcod2= '1' c endif * * Statut religieux : - Kasher - que certifiable c ctlb ifeq 1 c ctla andne 1 c eval vcrkasher= '50K' c eval vcr50kcod1= '2' c eval vcr50kcod2= '2' c endif * * Statut religieux : - Kasher - certifi‚ et certifiable c ctla ifeq 1 c ctlb andeq 1 c eval vcrkasher= '50K' c eval vcr50kcod1= '1' c eval vcr50kcod2= '2' c endif * * Statut religieux : - kasher indif‚rent c ctla ifne 1 c ctlb andne 1 c eval vcrkasher= '%%' c eval vcr50kcod1= '%%' c eval vcr50kcod2= '%%' c endif * Statut religieux - Kasher fin * * Statut religieux : - hallal - que certifi‚ c ctlc ifeq 1 c ctld andne 1 c eval vcrhallal= '50H' c eval vcr50hcod1= '1' c eval vcr50hcod2= '1' c endif * * Statut religieux : - hallal - que certifiable c ctld ifeq 1 c ctlc andne 1 c eval vcrhallal= '50H' c eval vcr50hcod1= '2' c eval vcr50hcod2= '2' c endif * * Statut religieux : - hallal - certifi‚ et certifiable c ctlc ifeq 1 c ctld andeq 1 c eval vcrhallal= '50H' c eval vcr50hcod1= '1' c eval vcr50hcod2= '2' c endif * * Statut religieux : hallal - indif‚rent c ctlc ifne 1 c ctld andne 1 c eval vcrhallal= '%%' c eval vcr50hcod1= '%%' c eval vcr50hcod2= '%%' c endif * Statut religieux - fin * * AllergŠnes c ctle ifeq 1 c eval vcrallerg= '1' c else c eval vcrallerg= '%%' c endif * AllergŠnes - fin * * Ogm c ctlf ifeq 1 c eval vcrogm = '1' c else c eval vcrogm = '%%' c endif * Ogm - fin * * Recherche dans tout le fichiers produits : c ctl1 ifeq 1 c eval vcrselect = '%%' c else c eval vcrselect = 'O' c endif * * Valeur point eclair c crecla ifeq 0 c eval vcrecla = '0' c else c movel crecla vcreclatmp1 3 c eval vcrecla = vcreclatmp1 c endif c eval vcrecla = %trim(vcrecla) * Valeur point eclair - fin * * Prix de revient c crprixre ifeq 0 c eval vcrprixre = '999999,00' c else c movel crprixre vcrprixretmp1 6 c move crprixre vcrprixretmp2 2 c eval vcrprixre=vcrprixretmp1 c eval vcrprixre=vcrprixre +',' c eval vcrprixre=vcrprixre + vcrprixretmp2 c endif c eval vcrprixre = %trim(vcrprixre) * Prix de revient - fin * * Solvant/support c crsupport ifeq *blank c eval vcrsupport= '%%' c else c move *blank vcrsupport c eval vcrsupport= '%' + crsupport + '%' c endif * Solvant/support - fin * * Legislation Pays/Statut ex : pays=(*blank) Statut= (*blank) c crpays ifeq *blank c crstatut andeq *blank c eval vcrLegis = '%%' c endif * * Legislation Pays/Statut ex : pays=F Statut= (*blank) c crpays ifne *blank c crstatut andeq *blank c eval vcrLegis = '%'+crPays+'%' c endif * * Legislation Pays/Statut ex : pays=(*blank) Statut=NI c crpays ifeq *blank c crstatut andne *blank * %trim pour prendre ex : NI* c eval vcrLegis = '%'+%trim(crStatut)+'%' c endif * * Legislation Pays/Statut ex : pays=F Statut=NI c crpays ifne *blank c crstatut andne *blank * %trim pour prendre ex : NI* c eval vcrLegis='%'+crPays+ ' ' c eval vcrLegis=vcrLegis + %trim(crStatut)+'%' c endif * Legislation Pays/Statut - fin * * * Echantillon code societe c crecodsoc ifeq *blank c crelibsoc andeq *blank c move *blank vcrecodsoc c eval vcrecodsoc = '%%' c endif * c crecodsoc ifne *blank c move *blank vcrecodsoc c eval vcrecodsoc = '%' + %trim(crecodsoc) + ' ' c eval vcrecodsoc=vcrecodsoc+%trim(crelibsoc)+'%' c endif * c crecodsoc ifeq *blank c crelibsoc andne *blank c move *blank vcrecodsoc c eval vcrecodsoc = '%' + %trim(crelibsoc) + '%' c endif c * Echantillon code societe - fin * * Echantillon code pays c crecodpay ifeq *blank c crelibpay andeq *blank c move *blank vcrecodpay c eval vcrecodpay = '%%' c endif * c crecodpay ifne *blank c move *blank vcrecodpay c eval vcrecodpay = '%' + %trim(crecodpay) + ' ' c eval vcrecodpay=vcrecodpay+%trim(crelibpay)+'%' c endif * c crecodpay ifeq *blank c crelibpay andne *blank c move *blank vcrecodpay c eval vcrecodpay = '%' + %trim(crelibpay) + '%' c endif * Echantillon code pays - fin c * Echantillon annee c creannee ifeq *blank c eval vcreannee = '%%' c else c move *blank vcreannee c eval vcreannee = '%' + creannee + '%' c endif * Echantillon annee - fin * * Vendu code societe c crvcodsoc ifeq *blank c crvlibsoc andeq *blank c move *blank vcrvcodsoc c eval vcrvcodsoc = '%%' c endif * c crvcodsoc ifne *blank c move *blank vcrvcodsoc c eval vcrvcodsoc = '%' + %trim(crvcodsoc) + ' ' c eval vcrvcodsoc=vcrvcodsoc+%trim(crvlibsoc)+'%' c endif * c crvcodsoc ifeq *blank c crvlibsoc andne *blank c move *blank vcrvcodsoc c eval vcrvcodsoc = '%' + %trim(crvlibsoc) + '%' c endif * Vendu code societe - fin * * Vendu code pays c crvcodpay ifeq *blank c crvlibpay andeq *blank c move *blank vcrvcodpay c eval vcrvcodpay = '%%' c endif * c crvcodpay ifne *blank c move *blank vcrvcodpay c eval vcrvcodpay = '%' + %trim(crvcodpay) + ' ' c eval vcrvcodpay=vcrvcodpay+%trim(crvlibpay)+'%' c endif * c crvcodpay ifeq *blank c crvlibpay andne *blank c move *blank vcrvcodpay c eval vcrvcodpay = '%' + %trim(crvlibpay) + '%' c endif * Vendu code pays - fin * * Vendu annee c crvannee ifeq *blank c eval vcrvannee = '%%' c else c move *blank vcrvannee c eval vcrvannee = '%' + crvannee + '%' c endif * Vendu annee - fin * * Famille c crcodfam ifeq *blank c eval vfamille = '%%' c else c move *blank vfamille c eval vfamille = '%' + crcodfam c* Approuv‚ c ctl2 ifeq 1 c eval vfamille = vfamille + 'O%' c else c eval vfamille = vfamille + '%' c endif c* Approuv‚ - fin c endif * Famille - fin c* * Profil c crprofil ifeq *blank c eval vprofil = '%%' c else c move *blank vprofil c eval vprofil = '%' + crprofil + '%' c endif * Famille - fin c* * Analyse l'ecran CritŠres en vue de la redactions du texte SQL - fin c* * Redaction de l'expression SQL * clear pour ne pas cumuler des blanc dans la zone c move *blank s c move *blank t c clear s c clear t c move ' and ' a 5 c move ' like ' l 6 c move '''' q 1 C eval s='select s4refpro,s4appel1' * c vcrselect ifeq '%%' C eval s=s + ' from slwork ' c else C eval s=s + ' from slworkl2 ' c endif * c vcrappel1 ifne '%%' C eval t=t+'s4appel1'+l+q+vcrappel1+q c endif * c vcrcontre ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4contre'+l+q+vcrcontre+q c endif * c vcrnotes1 ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4notes1'+l+q+vcrnotes1+q c endif * c vcrcouleu ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4codcou'+l+q+vcrcouleu+q c endif * c vcrcolorant ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4colora'+l+q+vcrcolorant+q c endif * c vcraspect ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4codasp'+l+q+vcraspect+q c endif * c vcrkasher ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'(s450kcod'+l+q+vcr50kcod1+q C eval t=t+' or ' C eval t=t+' s450kcod'+l+q+vcr50kcod2+q+')' c endif * c vcrhallal ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'(s450hcod'+l+q+vcr50hcod1+q C eval t=t+' or ' C eval t=t+' s450hcod'+l+q+vcr50hcod2+q+')' c endif * c vcrallerg ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4yacod'+l+q+vcrallerg+q c endif * c vcrogm ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4ogmcod'+l+q+vcrogm+q c endif * c vcrecla ifne '0' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4valpoi >=' + vcrecla c endif * c vcrprixre ifne '999999,00' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4prixre <' + vcrprixre c endif * C* s4valpoi >=:crecla and C* s4prixre <:vcrprixre and * c vcrsupport ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4sucod'+l+q+vcrsupport+q c endif * c vcrLegis ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4Legis'+l+q+vcrLegis+q c endif * c vcrecodsoc ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4scclt'+l+q+vcrecodsoc+q c endif * c vcrecodpay ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4scpay'+l+q+vcrecodpay+q c endif * c vcreannee ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4scaa '+l+q+vcreannee +q c endif * c vcrvcodsoc ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4opclf'+l+q+vcrvcodsoc +q c endif * c vcrvcodpay ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4opplv'+l+q+vcrvcodpay +q c endif * c vcrvannee ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4opdea'+l+q+vcrvannee +q c endif * c vfamille ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4apfam'+l+q+vfamille +q c endif * c vprofil ifne '%%' c 's4' scan t 70 c *in70 ifeq '1' c eval t=t+a c endif C eval t=t+'s4approf'+l+q+vprofil +q c endif * c t ifne *blank c eval s=s + ' where ' + t c endif c* * Redaction de l'expression SQL c* C* c+ fetch first 100 rows only C/EXEC SQL PREPARE requete FROM :s C/END-EXEC C/EXEC SQL declare recset1 cursor for requete C/END-EXEC C/EXEC SQL open recset1 C/END-EXEC * * init sfl : c move '0' *in50 C Z-ADD 1 hautpage0 c z-add 0 ligne0 4 0 c write CTlfe c move '1' *in50 c move '0' *in64 * init sfl - fin c*==================================================================== * detail : c chargfe tag c sqlstt doweq '00000' C/EXEC SQL fetch from recset1 into :ECREFDEF, :ECAPPEL1 C/END-EXEC * limite du sous fichier : 9999 lignes c sqlstt ifeq '00000' c ligne0 andlt 9999 c add 1 ligne0 c write detailfe c endif c enddo * detail - fin * C/EXEC SQL close recset1 C/END-EXEC * c ligne0 ifeq 0 C MOVE TblAno(1) LIBANO C MOVEl LIBANO CRMSGERR c goto crit c else C MOVE *BLANK LIBANO C MOVE *BLANK CRMsgErr c endif c z-add ligne0 nbarom * c afffe tag C Z-ADD 1 PAGAFF0 * c exfmt CTLFE * * c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif * c wsenrc chain detailfe 99 c *in99 ifeq '0' c goto afffiche c else c goto afffe c endif * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * * SousFichier * c afffiche tag * * FICHE AROME * c*==================================================================== c* Affichage fiche Arome ********************************************** c*==================================================================== c move *blank ecrefpro c move *blank ecappel1 c move *blank eccontre c move *blank ecnotes1 c move *blank ecnotes2 C MOVE *blank ecnotes3 C MOVE *blank ecnotes4 c move *blank eccodcrea c move *blank eclibcrea c move *blank ecselect c z-add *zero ececla c z-add *zero ecprixre c z-add *zero ecdatecrea c move *blank eccoul c move *blank ecaspe c move *blank eccash1 c move *blank eccash2 c move *blank echall1 c move *blank echall2 c move *blank ecaller c move *blank ecogm C MOVE *ZEROS ecSTOCK c move *blank eccolo * c ecrefdef chain slworkf1 99 c *in99 ifeq '0' * * Case … cocher 'fait partie du fichier s‚l‚ction' : c s4select ifeq 'O' c move '1' ecselect c else c move '2' ecselect c endif * c movel s4refpro ecrefpro c movel s4appel1 ecappel1 c movel s4contre eccontre c movel s4notes1 ecnotes1 c move s4notes1 ecnotes2 c movel s4codcrea eccodcrea c movel s4libcrea eclibcrea * c z-add s4valpoi ececla c z-add s4datecr2 ecdatecrea c move s4prixre ecprixre c movel s4valcou eccoul c movel s4valasp ecaspe c eval eccolo = %trim(s4codcol) * * Kasher : c s450kcod ifeq '1' c move 'x' eccash1 c else c s450kcod ifeq '2' c move 'x' eccash2 c endif c endif * * Hallal : c s450hcod ifeq '1' c move 'x' echall1 c else c s450hcod ifeq '2' c move 'x' echall2 c endif c endif * * AllergŠnes : c s4yacod ifeq '1' c move 'x' ecaller c endif * * OGM : c s4ogmcod ifeq '1' c move 'x' ecogm c endif * * - Calcul Stock C ecrefdef SETLL STOCKSF1 C DO *HIVAL C ecrefpro READE STOCKSF1 98 C *IN98 IFEQ '0' C STQIN ADD STQEN ZON113 11 3 C SUB STQSO ZON113 C ADD ZON113 ecSTOCK C END C N98 END * - Calcul Stock - Fin * * recherche observation c movel ecrefpro kid C recobs CHAIN slobseF1 97 c *in97 ifeq '0' C MOVEl s2notes1 ecnotes3 C MOVE s2notes1 ecnotes4 c endif * recherche observation - Fin * c endif c afffich1 tag * c exfmt fiche * * Bouton Parents : c *in01 ifeq '1' c pshbtn1 oreq 1 c goto debparen c endif * * Bouton Statuts : c *in02 ifeq '1' c pshbtn2 oreq 2 c goto debstatu c endif * * Bouton Support : c *in03 ifeq '1' c pshbtn3 oreq 3 c goto debsuppor c endif * * Bouton Famille : c *in04 ifeq '1' c pshbtn4 oreq 4 c move *blank EcValid c goto afffam c endif * * Bouton Vendus : c *in05 ifeq '1' c pshbtn5 oreq 5 c goto affvendu c endif * * Bouton Echantillons : c *in06 ifeq '1' c pshbtn6 oreq 6 c goto affechan c endif * * Bouton Applications : c *in07 ifeq '1' c pshbtn7 oreq 7 c eval eccodfam = '%%' c goto affappli c endif * * Bouton Legislations : c *in08 ifeq '1' c pshbtn8 oreq 8 c goto afflegis c endif * * Bouton Valider : c *in09 ifeq '1' c pshbtn9 oreq 9 * - maj fichier selection c move *blank dvcontre c move *blank dvnotes1 c ecrefpro chain slardvf1 99 c *in99 ifeq '0' c movel eccontre dvcontre c eval dvnotes1 = ecnotes1 + ecnotes2 c ecselect ifeq 1 c move ' ' dvtag c else c move '*' dvtag c endif c update slardvf1 c endif * - maj fichier selection - fin * - maj fichier slwork c ecrefpro chain slworkf1 99 c *in99 ifeq '0' c movel ecrefpro s4refpro c ecselect ifeq 1 c move 'O' s4select c else c move 'N' s4select c endif c movel eccontre s4contre c eval s4notes1 = ecnotes1 + ecnotes2 c update slworkf1 c endif * - maj fichier slwork - fin * * - Enregistre les observations perso C recobs CHAIN slobseF1 97 C MOVEl ecrefpro s2refpro C MOVEl kusr s2user C eval s2notes1 = ecnotes3 + ecnotes4 c *in97 ifeq '0' C UPDATE slobseF1 c else C write slobseF1 c endif * - Enregistre les observations perso - Fin * c movel TblAno(6) EcValid c goto afffiche c endif * * Bouton Liste : c *in11 ifeq '1' c pshbtn11 oreq 11 c RetourCrit andeq ' ' c goto afffe c endif * * Bouton Retour : c *in12 ifeq '1' c pshbtn12 oreq 12 c move *blank crrefdef c goto crit c else c goto afffich1 c endif * c*==================================================================== c* Fin Affichage fiche Arome ***************************************** c*==================================================================== * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * SousFichier * * * PARENTS c*==================================================================== c debparen tag c* Affichage du sous fichier parent *********************************** c*==================================================================== c move '0' *in97 c move *blank ecmsgerr c move *blank EcValid * init sfl : c move '0' *in50 C Z-ADD 1 hautpage5 c z-add 0 ligne5 3 0 c write ctlparen c move '1' *in50 c move '0' *in64 * init sfl - fin c*==================================================================== * detail : c chargparen tag *-------------------------------------------------------------------- c* - recupŠre le numero de groupe c ecrefpro chain slparef1 99 c *in99 ifeq '0' c move s2groupe groupesv 6 0 c else c z-add *zeros groupesv 6 0 c endif c* - recupŠre le numero de groupe - fin *-------------------------------------------------------------------- * *-------------------------------------------------------------------- c* - pour chaque groupe identique, remplir le sfl c groupesv chain slparef6 99 c *in99 ifeq '0' c s2groupe doweq groupesv * et si je suis pas fin de fichier c *in97 andeq '0' c add 1 ligne5 c move s2refpro ecrefpro2 c z-add s2groupe ecgroupe c move s2detail ecdetail c move s2version ecversion * * je met en rouge le produit en cours de consulation * et deprotection de la zone pour la saisie c ecrefpro ifeq s2refpro c move '1' *in70 c move '1' *in71 c else c move '0' *in70 c move '0' *in71 c endif * c read slparef6 97 c write sflparen c enddo c c endif c* - pour chaque groupe identique, remplir le sfl - fin *-------------------------------------------------------------------- * *-------------------------------------------------------------------- * Une ligne blanche minimum (si sfl vide - produit sans groupe) c ligne5 ifeq 0 c move '1' *in70 c move '1' *in71 c move ecrefpro ecrefpro2 c move *blank ecdetail c move *blank ecgroupe c move *blank ecversion c add 1 ligne5 c write sflparen c move '0' *in70 c move '0' *in71 c endif *-------------------------------------------------------------------- * c affparen tag C Z-ADD 1 PAGAFF5 c move '0' *in09 * c exfmt ctlparen * * Bouton Valider : c *in09 ifeq '1' c pshbtn9 oreq 9 * c readc sflparen 60 * c *in60 ifeq '0' * *===================================================================== c * si ecversion = SUPPRI aller directement … supprparen c ecversion ifeq 'SUPPRI' c goto SupprParen c endif * si ecversion = SUPPRI aller directement … supprparen - fin *===================================================================== * si ecversion est … blanc pas de validation c ecversion ifeq *blank c eval ecmsgerrpa='Blanc Interdit' c goto debparen c endif * si ecversion est … blanc pas de validation - fin * *===================================================================== * si ecversion = ecrefpro2, pas de validation c ecversion ifeq ecrefpro2 c eval ecmsgerrpa='Redondance Cyclique' c goto debparen c endif * si ecversion = ecrefpro2, pas de validation - fin * *===================================================================== * si ecversion n'existe pas,pas de validation c ecversion chain slworkf1 99 c *in99 ifeq '1' c eval ecmsgerrpa='Parent Inexistant' c goto debparen c endif * si ecversion n'existe pas,pas de validation - fin * *===================================================================== * Si ‡… se mort la queue , pas de validation c ecversion chain slparef1 99 c *in99 doweq '0' c c ecrefpro2 ifeq s2version c eval ecmsgerrpa='Redondance Cyclique' c goto debparen c endif c c s2version chain slparef1 99 c enddo * Si ‡… se mort la queue , pas de validation - fin *===================================================================== *jen suis la * Ajout d'un enfant … un groupe existant c ecversion chain slparef1 99 c *in99 ifeq '0' c ecgroupe andeq 0 * - enfant c move ecrefpro s2refpro c move ecdetail s2detail c move ecversion s2version c eval ecmsgerrpa='Affectation … un groupe existant' c write slparef1 c goto debparen * - enfant - fin c endif * Ajout d'un enfant … un groupe existant - fin * *===================================================================== * Ajout d'un enfant - Nouveau groupe * Non pr‚sent dans slpare donc nouveau groupe c ecversion chain slparef1 99 c *in99 ifeq '1' c ecgroupe andeq 0 C* UTILISATION DTAARA - calcul du max + 1 C *DTAARA DEFINE slpare cpteur 6 0 C *LOCK IN CPTEUR C ADD 1 CPTEUR C z-add CPTEUR s2groupe C OUT CPTEUR C UNLOCK CPTEUR * UTILISATION DTAARA - calcul du max + 1 - fin * * - enfant c move ecrefpro s2refpro c move ecdetail s2detail c move ecversion s2version c write slparef1 * - enfant - fin * * - parent c move s2version s2refpro C z-add CPTEUR s2groupe c move *blank s2detail c eval s2detail='JE SUIS UN PARENT' c move *blank s2version c eval ecmsgerrpa='Affectation … un nouveau groupe' c write slparef1 * - parent - fin c goto debparen c endif * Ajout d'un enfant - Nouveau groupe - fin * *===================================================================== * si c'est une maj c *///////////////////////////le nouveau groupe existe dej… c ecversion chain slparef1 99 c *in99 ifeq '0' c ecgroupe andne 0 c* je recupŠre le numero du nouveau groupe d'affectation c move s2groupe s2groupesv 6 0 c endif */////////////////////////// c * *'''''''''''''''''''''''''''le nouveau groupe n'existe pas c ecversion chain slparef1 99 c *in99 ifeq '1' c ecgroupe andne 0 C* UTILISATION DTAARA - calcul du max + 1 C *LOCK IN CPTEUR C ADD 1 CPTEUR C z-add CPTEUR s2groupe c z-add CPTEUR s2groupesv 6 0 C OUT CPTEUR C UNLOCK CPTEUR * UTILISATION DTAARA - calcul du max + 1 - fin * * - parent c move ecversion s2refpro C z-add CPTEUR s2groupe c move *blank s2detail c eval s2detail='JE SUIS UN PARENT' c move *blank s2version c eval ecmsgerrpa='Affectation Effectu‚e' c write slparef1 * - parent - fin c endif *''''''''''''''''''''''''''' c c*""""""""""""""""""""""""""maj du parent c ecrefpro2 chain slparef1 99 c *in99 ifeq '0' c ecgroupe andne 0 c move ecrefpro2 s2refpro C z-add s2groupesv s2groupe c move ecdetail s2detail c move ecversion s2version c eval ecmsgerrpa='Affectation Effectu‚e' c update slparef1 c endif c*"""""""""""""""""""""""""" * c*((((((((((((((((((((((((((deplace enfants de ce parent c ecrefpro2 chain slparef1 99 c *in99 ifeq '0' c ecgroupe andne 0 * si ecgroupe=s2groupesv,c'est une maj du detail seulement c ecgroupe andne s2groupesv c z-add ecgroupe ecgrp * c move *blank tbl1 c z-add 1 c 3 0 c eval tbl1(c)=ecrefpro2 c z-add 1 suivant 3 0 c* map c tbl1(suivant) downe *blank c eval ecref = tbl1(suivant) c add 1 suivant c blcgroup tag c rec chain slparef7 98 c *in98 ifeq '0' c add 1 c c eval tbl1(c) = s2refpro c move s2groupesv s2groupe c update slparef7 c goto blcgroup c endif c enddo c* map - fin c endif c*(((((((((((((((((((((((((( * si c'est une maj - fin * *===================================================================== * si ecversion contient SUPPRI, cela supprimer la ligne et ses * enfants eventuels c SupprParen tag c ecversion ifeq 'SUPPRI' c c* - suppr la ligne c ecrefpro2 chain slparef1 99 c *in99 ifeq '0' c ecgroupe andne 0 c eval ecmsgerrpa='Suppression effectu‚e' c delete slparef1 c* - suppr la ligne - fin c*##########################supprim enfants de ce parent c z-add ecgroupe ecgrp * c move *blank tbl1 c z-add 1 c 3 0 c eval tbl1(c)=ecrefpro2 c z-add 1 suivant 3 0 c* map c tbl1(suivant) downe *blank c eval ecref = tbl1(suivant) c add 1 suivant c blcgroup2 tag c rec chain slparef7 98 c *in98 ifeq '0' c add 1 c c eval tbl1(c) = s2refpro c delete slparef7 c goto blcgroup2 c endif c enddo c* map - fin c endif c*##########################supprim enfants de ce parent - fin c c c c goto debparen c endif * si ecversion contient SUPPRI - Fin *===================================================================== c goto debparen * fin readc : c endif * fin Bouton Valider : c endif * * Bouton Retour : c *in12 ifeq '1' c pshbtn12 oreq 12 c move '0' *in12 c goto afffich1 c else c goto affparen c endif c********************================================================= * fin sfl parents =================================================== * * * * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * * SousFichier * * * SUPPORT * c*==================================================================== c debsuppor tag c* Affichage du sous fichier legislation (support) ******************** c*==================================================================== c move '0' *in50 c z-add 0 ligne7 3 0 c write ctlsupport c move '1' *in50 c move '0' *in64 c move *blank ecmsgerr c move *blank EcValid c* fin ctl c*==================================================================== * detail c chargsuppo tag c s4refpro setll slarsuf1 c read slarsuf1 c s4refpro doweq supro c add 1 ligne7 c movel *blank eccodsupp c movel *blank eclibsupp * Recherche du libell‚ Support c sucod ifne *blank c movel '58' kpos c move sucod kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel sucod eccodsupp c movel fozon1 eclibsupp c else c movel *blank eccodsupp c movel 'Inconnu' eclibsupp c endif c endif * Recherche du libell‚ Support - fin c write sflsupport c read slarsuf1 c enddo * c affsuppo tag C Z-ADD 1 PAGAFF7 * c ligne7 ifeq 0 c movel TblAno(3) EcMsgErr c goto afffich1 c endif c exfmt ctlsupport * * Bouton Retour : c *in12 ifeq '1' c pshbtn12 oreq 12 c goto afffich1 c else c goto affsuppo c endif c*==================================================================== * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * * SousFichier * * * L‚gislation * c*==================================================================== c afflegis tag c*==================================================================== c exfmt legis * * Bouton Retour : c *in12 ifeq '1' c pshbtn12 oreq 12 c goto afffich1 c else c goto afflegis c endif c*==================================================================== * * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * SousFichier * * * * PAYS STATUS * c*==================================================================== c debstatu tag c* Affichage du sous fichier legislation (pays statut) **************** c*==================================================================== c move '0' *in50 c z-add 0 ligne1 3 0 c write ctlstatu c move '1' *in50 c move '0' *in64 c move *blank ecmsgerr c move *blank EcValid c* fin ctl c*==================================================================== * detail c chargstatu tag c s4refpro setll slarpyf1 c read slarpyf1 c s4refpro doweq pypro c add 1 ligne1 c movel *blank eccodpays c movel *blank eclibpays * Recherche du libell‚ Pays c pycod ifne *blank c movel '55' kpos c move pycod kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel pycod eccodpays c movel fozon1 eclibpays c else c movel *blank eccodpays c movel 'Inconnu' eclibpays c endif c endif * Recherche du libell‚ Pays - fin * * Recherche du libell‚ Satut c movel *blank eccodstat c movel *blank eclibstat c pyleg ifne *blank c movel '56' kpos c move pyleg kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel pyleg eccodstat c movel fozon1 eclibstat c else c movel *blank eccodstat c movel 'Inconnu' eclibstat c endif c endif * Recherche du libell‚ Statut - fin c write sflstatu c read slarpyf1 c enddo * c affstatu tag C Z-ADD 1 PAGAFF1 * c ligne1 ifeq 0 c movel TblAno(4) EcMsgErr c goto afffich1 c endif * c exfmt ctlstatu * * Bouton Retour : c *in12 ifeq '1' c pshbtn12 oreq 12 c goto afffich1 c else c goto affstatu c endif c*==================================================================== * * * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * SousFichier * * Famille * c*==================================================================== c afffam tag c* Affichage du sous fichier Famille ****************************** c*==================================================================== c move '0' *in50 C Z-ADD 1 hautpage2 c z-add 0 ligne2 3 0 c write ctlfam c move '1' *in50 c move '0' *in64 c move *blank ecmsgerr c* fin ctl c*==================================================================== * detail C/EXEC SQL declare recfam cursor for C+ select apfam,approf,apappr C+ from slarap C+ where appro like :ecrefdef C+ and apfam not like ' ' C+ group by apfam,approf,apappr C/END-EXEC c* C/EXEC SQL open recfam C/END-EXEC c sqlstt doweq '00000' C/EXEC SQL fetch from recfam into :kcle,:ecprofil,:ecapprouve C/END-EXEC c sqlstt ifeq '00000' c add 1 ligne2 * - Recherche libell‚ Famille c move '44' kpos c evalr kcle = %trim(kcle) c recenr chain fourtof0 99 c *in99 ifeq '0' c movel fozon1 ecfamille c endif * - Recherche libell‚ Famille - Fin c move kcle eccodfam c write sflfam c endif c enddo C/EXEC SQL close recfam C/END-EXEC * * Une ligne blanche minimum (antibug du sfl) c add 1 ligne2 c move *blank ecfamille c move *blank ecprofil c move *blank ecapprouve c move *blank eccodfam c write sflfam * detail - fin C Z-ADD 1 PAGAFF2 c c afffam2 tag c exfmt ctlfam * * Validation Fammile c *in09 ifeq '1' c pshbtn9 oreq 9 * c blcsflfam tag * c readc sflfam 60 c *in60 ifeq '0' c move *blank approf c move *blank apappr * * R‚p‚tition profil et approbation * Positionnement sur le premier produit de slarap * Pour r‚p‚ter le profil et l'approbation sur toutes les lignes c move ecrefdef pro c move *blank appli c recappli setll slarapf1 c read slarapf1 * * Boucle pour tout produit identique c ecrefdef doweq appro c movel ecprofil approf c move ecapprouve apappr * si Famille identique, maj c eccodfam ifeq apfam c update slarapf1 c endif * c read slarapf1 c enddo * R‚p‚tition profil et approbation - fin c goto blcsflfam c endif c movel TblAno(6) EcValid c goto afffam c endif * Validation Famille - Fin * * Bouton Retour : c *in12 ifeq '1' c pshbtn12 oreq 12 c goto afffich1 c endif * * Double click sur une Famille : c wsenrc2 chain sflfam 98 c *in98 ifeq '0' c move '1' retourfam 1 c goto affappli c endif * c goto afffam2 * * * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * * SousFichier * * * * APPLICATION - d‚tail de famille * * c*==================================================================== c affappli tag c* Affichage du sous fichier application ****************************** c*==================================================================== c move ecfamille eclibfam * c move '0' *in50 C Z-ADD 1 hautpage6 c z-add 0 ligne6 3 0 c write ctlappli c move '1' *in50 c move '0' *in64 c move *blank ecmsgerr c move *blank EcValid c* fin ctl c*==================================================================== * detail C/EXEC SQL declare appli cursor for C+ select apcod,apdos C+ from slarap C+ where appro like :ecrefdef C+ and apfam like :eccodfam C+ and apfam not like ' ' C/END-EXEC c* C/EXEC SQL open appli C/END-EXEC c sqlstt doweq '00000' C/EXEC SQL fetch from appli into :eccodappli,:ecdosage C/END-EXEC c sqlstt ifeq '00000' c add 1 ligne6 * - Recherche libell‚ Application c move '54' kpos c evalr kcle = %trim(eccodappli) c recenr chain fourtof0 99 c *in99 ifeq '0' c movel fozon1 eclibappli c endif * - Recherche libell‚ Application - Fin c move eccodappli eccodsave c write sflappli c endif c enddo C/EXEC SQL close appli C/END-EXEC * Rempli 10 lignes vierges pour ajouter des Applications c do 10 c add 1 ligne6 c move *blank eccodappli c move *blank eclibappli c move *blank ecdosage c move *blank eccodsave c write sflappli c enddo * detail - fin * c afffich6 tag C Z-ADD 1 PAGAFF6 * c exfmt ctlappli * * d‚tection double click * c wsenrc chain detailfe 99 c *in99 ifeq '0' c exsr ListAppl c endif * * Validation Application * * Bouton Valider : c *in09 ifeq '1' c pshbtn9 oreq 9 * c blcsflappli tag c readc sflappli 60 c *in60 ifeq '0' c move *blank apfam * * - recherche du code famille - c move '54' kpos c move eccodappli kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel fozon1 vartmp 22 c endif * - recherche du code famille - fin * * SUPRESSION SUPPRESSION SUPPRESSION SUPPRESSION SUPPRESSION SUPPRESSI * - recherche si Suppression c eccodappli ifeq *blank c eccodsave andne *blank c move *blank pro c move *blank appli c move ecrefdef pro c move eccodsave appli c recappli chain slarapf1 99 * * Suppression : c *in99 ifeq '0' c delete slarapf1 c endif c endif * - recherche si Suppresion - Fin *sssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss * * AJOUT AJOUT AJOUT AJOUT AJOUT AJOUT AJOUT AJOUT AJOUT AJOUT AJOUT * - recherche sil existe pour ajouter c eccodappli ifne *blank c eccodsave andeq *blank c move ecrefdef pro c move eccodappli appli c recappli chain slarapf1 99 * - recherche si existe d‚j… - fin c *in99 ifeq '1' * r‚cup‚ration du profil et approuv‚ s'il existe c movel *blank ecprofil c move *blank ecapprouve c move vartmp vartmp2 2 c move ecrefdef pro c move *blank appli c recappli setll slarapf1 c read slarapf1 c ecrefdef doweq appro c apfam ifeq vartmp2 c movel approf ecprofil c move apappr ecapprouve c endif c read slarapf1 c enddo * r‚cup‚ration du profil et approuv‚ - fin c move ecrefdef appro c move eccodappli apcod c z-add ecdosage apdos c z-add 0 apnat c move *blank aptyp c move *blank aptom c movel ecprofil approf c move ecapprouve apappr c move vartmp apfam * * Pour ne pas ajouter une appli qui n'existe pas c apfam ifne *blank c write slarapf1 c endif * c endif c c endif c*aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa * * MODIFIER MODIFIER MODIFIER MODIFIER MODIFIER MODIFIER MODIFIER * - recherche si existe d‚j… pour le modifier c eccodappli ifne *blank c eccodsave andne *blank c eccodappli andeq eccodsave c move ecrefdef pro c move eccodappli appli c recappli chain slarapf1 99 * - recherche si existe d‚j… - fin * c *in99 ifeq '0' c move ecrefdef appro c move eccodappli apcod c z-add ecdosage apdos c move vartmp apfam * * pour ne maj une appli qui n'existe pas c apfam ifne *blank c update slarapf1 c endif * Fin *in99 : c endif * c endif * FIN MODIFIER FIN MODIFIER FIN MODIFIER FIN MODIFIER FIN MODIFIER *mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm * c goto blcsflappli * Fin readc du sflappli c endif c goto affappli * Fin F9 Validation : c endif * Validation Application - Fin * * F12 Retour vers Famille si j'en viens : c *in12 ifeq '1' c retourfam andeq '1' c move *blank retourfam c goto afffam c endif * * Bouton Retour vers Famille si j'en viens : c pshbtn12 ifeq 12 c retourfam andeq '1' c move *blank retourfam c goto afffam c endif * * F12 Retour vers Fiche Arome si j'en viens : c *in12 ifeq '1' c retourfam andeq *blank c goto afffich1 c endif * * Bouton Retour vers Fiche Arome si j'en viens : c pshbtn12 ifeq 12 c retourfam andeq *blank c goto afffich1 c else c goto afffich6 c endif *= fin affichage application ===========================* * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * SousFichier * * ECHANTILLON * c*==================================================================== c affechan tag c* Affichage du sous fichier Echantillon ***************************** c*==================================================================== c move 'N' echan2 1 c z-add 0 cpt 3 0 c move '0' *in50 C Z-ADD 1 hautpage3 c z-add 0 ligne3 3 0 c write ctlechan c write ctlechan2 c move '1' *in50 c move '0' *in64 c move *blank ecmsgerr c move *blank EcValid c* fin ctl *===================================================================== * detail * * Recherche de tous les Echantillons pour une r‚f‚rence * c c z-add *zero ligne3sv 3 0 c s4refpro setll soucomf1 c read soucomf1 c chargechan tag c z-add ligne3sv ligne3 c z-add 1 cumul 4 0 c cumul dowle 10 c s4refpro andeq scpro c movel *blank ecanne c movel *blank eccodpay2 c movel *blank eclibpay2 c movel *blank eccodsoci c movel *blank eclibsoci c movel *blank inconnu1 c movel *blank inconnu2 c add 1 ligne3 c add 1 cumul c z-add ligne3 ligne3sv c add 1 cpt c z-add cpt eccpt c movel scaa ecanne c movel scpay eccodpay2 c z-add scjj ecjj c z-add scmm ecmm c * * - Recherche du libell‚ Pays Echantillons c move *blank rarg c movel scpay rarg c recpays chain fan100p1 99 c *in99 ifeq '0' c movel tlib1 eclibpay2 c else c movel 'Inconnu' eclibpay2 c endif * - Recherche du libell‚ Pays Echantillons - fin * c movel scclt eccodsoci * Recherche du libell‚ Societe echantillons * recherche dans souclt c move scclt codclt 8 c exsr clientsouclt * recherche dans souclt - Fin * * recherche dans robttt c move '00000000' aux 8 c eval variable = %trim(scclt) c move variable aux c exsr clientrobttt * recherche dans robttt - Fin * c inconnu1 ifeq '1' c inconnu2 andeq '1' c move 'Inconnu' eclibsoci c endif * * Recherche du libell‚ Societe echantillons - fin c write sflechan * c* Compl‚ment : c movel *blank eccodapp c movel *blank eclibapp c movel *blank ecdosage c movel *blank ecobsechan * - Recherche libell‚ Application c move *blank kcle c move '54' kpos c movel scapc vartmp2 c move vartmp2 kcle c recenr chain fourtof0 99 c *in99 ifeq '0' c movel scapc eccodapp c movel fozon1 eclibapp c endif * - Recherche libell‚ Application - Fin * * - Recherche Dosage c movel ecrefdef pro c movel scapc appli c recappli chain slarapf1 99 c *in99 ifeq '0' c z-add apdos ecdosage c endif * - Recherche Dosage - Fin * * - Commentaire Echantillons c move scsoc ecsoc c move sccdp eccdp c z-add sccda eccda c z-add sccd1 eccd1 c z-add sccd2 eccd2 c z-add scseq ecseq * - cle c move ecsoc ksoc c move eccdp kcdp c z-add eccda kcda c z-add eccd1 kcd1 c z-add eccd2 kcd2 c z-add ecseq kseq * - cle - fin c recsou chain slobecf1 96 c *in96 ifeq '0' c movel s3notes1 ecobsechan c else c movel *blank ecobsechan c endif c * - Commentaire Echantillons - fin * c write sflechan2 c* Compl‚ment - Fin * c read soucomf1 c enddo * c afffich3 tag * * la condition hautpage, cest pour la derniere page, sinon bug c hautpage3 ifgt ligne3 C Z-ADD ligne3 PAGAFF3 c else C Z-ADD hautpage3 PAGAFF3 c endif c* fin condition * c ligne3 ifeq 0 c Movel TblAno(5) EcMsgErr c goto afffich1 c endif * c echan2 ifeq 'N' c exfmt ctlechan c else c exfmt ctlechan2 c endif * c *in31 cabeq '1' chargechan * * Bouton Valider Commentaire : c *in09 ifeq '1' c pshbtn9 oreq 9 c readc sflechan2 97 c *in97 doweq '0' * - cle c move ecsoc ksoc c move eccdp kcdp c z-add eccda kcda c z-add eccd1 kcd1 c z-add eccd2 kcd2 c z-add ecseq kseq * - cle - fin c c recsou chain slobecf1 96 * - alimente les zones c move ecsoc s3soc c move eccdp s3cdp c z-add eccda s3cda c z-add eccd1 s3cd1 c z-add eccd2 s3cd2 c z-add ecseq s3seq c move ecrefpro s3refpro c movel ecobsechan s3notes1 * - alimente les zones - fin c *in96 ifeq '0' c update slobecf1 c else c write slobecf1 c endif c readc sflechan2 97 c enddo c movel TblAno(6) EcValid c goto afffich3 * fin du bouton : c endif * * Bouton Retour vers Applications: c *in10 ifeq '1' c pshbtn10 oreq 10 c move 'N' echan2 1 c z-add 0 pshbtn10 c goto afffich3 c endif * * Bouton Compl‚ment Echantillons : c *in11 ifeq '1' c pshbtn11 oreq 11 c Movel *blank EcValid c move 'O' echan2 1 c goto afffich3 c endif * * * Bouton Retour vers Fiche Arome : c *in12 ifeq '1' c pshbtn12 oreq 12 c goto afffich1 c else c goto afffich3 c endif * * * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * * SousFichier * * * VENDU * c*==================================================================== c affvendu tag c* Affichage du sous fichier Vendu ************************************ c*==================================================================== c move 'N' vendu2 1 c z-add 0 cpt 3 0 c move '0' *in50 C Z-ADD 1 hautpage4 c z-add 0 ligne4 3 0 c write ctlvendu c write ctlvendu2 c move '1' *in50 c move '0' *in64 c z-add *zero ligne4sv 3 0 c move *blank ecmsgerr c move *blank EcValid c* fin ctl c*==================================================================== * detail c movel '00' ecrefdef2 8 c move ecrefdef ecrefdef2 8 c eval x='' c eval x='select opdea,opplv,opclf,sum(opqte)' c eval x=x+' from ordreslt' c eval x=x+' where oppro =' c eval x=x+ ''''+ecrefdef2+'''' c eval x=x+ ' group by opdea,opplv,opclf' c eval x=x+ ' order by opdea desc' C/EXEC SQL PREPARE requete2 FROM :x C/END-EXEC C/EXEC SQL declare record2 cursor for requete2 C/END-EXEC C/EXEC SQL open record2 C/END-EXEC c* *===================================================================== c sqlstt doweq '00000' c z-add 0 antmp 2 0 c move *blank paystmp 3 c move *blank clttmp 8 c z-add 0 qtetmp 9 3 c move *blank obstmp 50 C/EXEC SQL fetch from record2 into :antmp,:paystmp,:clttmp,:qtetmp C/END-EXEC c sqlstt ifeq '00000' c add 1 cpt c eval an(cpt) = antmp c eval pays(cpt) = paystmp c eval client(cpt) = clttmp c eval qte(cpt) = qtetmp c c endif c enddo C/EXEC SQL close record2 C/END-EXEC *===================================================================== c z-add 1 cpt c chargvendu tag c z-add ligne4sv ligne4 c z-add 1 cumul 4 0 c cumul dowle 10 c client(cpt) andne *blank c add 1 cumul 4 0 c add 1 ligne4 c z-add ligne4 ligne4sv c z-add cpt eccpt c z-add an(cpt) ecanne2 c movel pays(cpt) eccodpay c movel client(cpt) eccodsoc c z-add qte(cpt) ecqte c add 1 cpt * - Recherche du libell‚ Pays c move *blank rarg c movel eccodpay rarg c recpays chain fan100p1 99 * c *in99 ifeq '0' c movel tlib1 eclibpay c else c movel 'Inconnu' eclibpay c endif * * - Recherche du libell‚ Pays Echantillons - fin * * - recherche dans robttt c move eccodsoc aux c recclt chain robtttf1 99 * c *in99 ifeq '0' c movel tknom eclibsoc c else c movel 'Inconnu' eclibsoc c endif * * - recherche dans robttt - fin c write sflvendu * c* Compl‚ment : c move ecrefpro kref c z-add ecanne2 kan c move eccodpay kpays c move eccodsoc kclt c * * - zone cach‚s pour la cle c move ecrefpro ecref c z-add ecanne2 ecan c move eccodpay ecpays c move eccodsoc ecclt * - zone cach‚s pour la cle - fin c movel *blank ecobs c recobsve chain slobvef1 99 * c *in99 ifeq '0' c movel s5notes1 ecobs c endif * c write sflvendu2 c* Compl‚ment : - fin c enddo * c afffich4 tag * * la condition hautpage, cest pour la derniere page, sinon bug c hautpage4 ifgt ligne4 C Z-ADD ligne4 PAGAFF4 c else C Z-ADD hautpage4 PAGAFF4 c endif c* fin condition * c ligne4 ifeq 0 c movel TblAno(2) EcMsgErr c goto afffich1 c endif * c vendu2 ifeq 'N' c exfmt ctlvendu c else c exfmt ctlvendu2 c endif * c *in31 cabeq '1' chargvendu c* exfmt ctlvendu * * Bouton Valider Commentaire : c *in09 ifeq '1' c pshbtn9 oreq 9 c readc sflvendu2 97 c *in97 doweq '0' * - cle c z-add ecan kan c move ecpays kpays c move ecclt kclt * - cle - fin c c recobsve chain slobvef1 96 * - alimente les zones c move ecref s5refpro c z-add ecan s5annee c move ecpays s5pays c move ecclt s5client c move ecref s5refpro c movel ecobs s5notes1 * - alimente les zones - fin c *in96 ifeq '0' c update slobvef1 c else c write slobvef1 c endif c readc sflvendu2 97 c enddo c Movel TblAno(6) EcValid c goto afffich4 * fin du bouton : c endif * * Bouton Retour vers Vendu : c *in10 ifeq '1' c pshbtn10 oreq 10 c move 'N' vendu2 1 c z-add 0 pshbtn10 c goto afffich4 c endif * * Bouton Compl‚ment Vendu : c *in11 ifeq '1' c pshbtn11 oreq 11 c move 'O' vendu2 1 c move *blank EcValid c goto afffich4 c endif * * Bouton Retour vers fiche Arome : c *in12 ifeq '1' c pshbtn12 oreq 12 C/EXEC SQL close record2 C/END-EXEC c goto afffich1 c else c goto afffich4 c endif * * * ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** ********************************************************************** * * SousProgramme * * C FIN TAG C SETON LR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Solvant/Support - Legislation CSR lstsupp BEGSR c move '0' *in50 C Z-ADD 1 hautpage8 c z-add 0 ligne8 4 0 c write lstctlsupp c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c movel '58' kpos c movel *blank kcle c recenr setll fourtof0 c read fourtof0 c dow fopos = '58' c add 1 ligne8 c move focle eccodsupp c movel fozon1 eclibsupp c write lstsupport c read fourtof0 c enddo * detail - fin C Z-ADD 1 PAGAFF8 c exfmt lstctlsupp c wsenrc chain lstsupport 99 c *in99 ifeq '0' c move eccodsupp crsupport c endif * * Bouton retour : c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Pays - Legislation CSR listpays BEGSR c move '0' *in50 C Z-ADD 1 hautpage9 c z-add 0 ligne9 4 0 c write lstctlpays c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c movel '55' kpos c movel *blank kcle c recenr setll fourtof0 c read fourtof0 c dow fopos = '55' c add 1 ligne9 c move focle eccodpays c movel fozon1 eclibpays c write lstpays c read fourtof0 c enddo * detail - fin C Z-ADD 1 PAGAFF9 c exfmt lstctlpays c wsenrc chain lstpays 99 c *in99 ifeq '0' c move eccodpays crpays c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Statut - Legislation CSR liststatut BEGSR c move '0' *in50 C Z-ADD 1 hautpage10 c z-add 0 ligne10 4 0 c write lstctlstat c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c movel '56' kpos c movel *blank kcle c recenr setll fourtof0 c read fourtof0 c dow fopos = '56' c add 1 ligne10 c move focle eccodstatu c movel fozon1 eclibstatu c write lststatut c read fourtof0 c enddo * detail - fin C Z-ADD 1 PAGAFF10 c exfmt lstctlstat c wsenrc chain lststatut 99 c *in99 ifeq '0' c move eccodstatu crstatut c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Pays - Echantillons CSR listEpays BEGSR c move '0' *in50 C Z-ADD 1 hautpage11 c z-add 0 ligne11 4 0 c write lstctlepay c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c move *blank rarg c recpays setll fan100p1 c read fan100p1 c dow rct = 'PY' c add 1 ligne11 c movel rarg eccodpays c movel tlib1 eclibpays c write lstEpay c read fan100p1 c enddo * detail - fin C Z-ADD 1 PAGAFF11 c exfmt lstctlepay c wsenrc chain lstepay 99 c *in99 ifeq '0' c move eccodpays crecodpay c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Soci‚t‚ - Echantillons CSR listEsoc BEGSR c cherchesoc tag c move '0' *in50 C Z-ADD 1 hautpage12 c z-add 0 ligne12 4 0 c write lstctlesoc c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail de robttt c eval vecherchsoc ='%'+%trim(echerchsoc) + '%' c echerchsoc ifeq *blank c goto vide c endif C/EXEC SQL declare recset4 cursor for C+ select tkaux,tknom,tkpays C+ from robttt C+ where tknom like :vecherchsoc C+ and tkseq = 'CLIENT' C/END-EXEC C/EXEC SQL open recset4 C/END-EXEC c* c sqlstt doweq '00000' C/EXEC SQL fetch from recset4 into :ECcodesoc,:EClibesoc,:eccodepay C/END-EXEC c sqlstt ifeq '00000' c add 1 ligne12 c add 1 cumul c* z-add ligne12 ligne12sv c write lstEsoc c endif c enddo C/EXEC SQL close recset4 C/END-EXEC * detail Clients provisoires C/EXEC SQL declare recset3 cursor for C+ select clcod,clnom,clpay C+ from souclt C+ where clnom like :vecherchsoc C/END-EXEC C/EXEC SQL open recset3 C/END-EXEC c sqlstt doweq '00000' C/EXEC SQL fetch from recset3 into :ECcodesoc,:EClibesoc,:eccodepay C/END-EXEC c sqlstt ifeq '00000' c add 1 ligne12 c add 1 cumul c* z-add ligne12 ligne12sv c write lstEsoc c endif c enddo C/EXEC SQL close recset3 C/END-EXEC c vide tag c add 1 ligne12 c move *blank eccodesoc c move *blank eclibesoc c move *blank eccodepay c write lstEsoc * detail - fin C Z-ADD 1 PAGAFF12 c exfmt lstctlesoc c wsenrc chain lstesoc 99 c *in99 ifeq '0' c move eccodesoc crecodsoc c endif c *in09 ifeq '1' c pshbtn9 oreq 9 c goto cherchesoc c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Soci‚t‚ - Vendus (ordres) CSR listVsoc BEGSR c cherchvsoc tag c move '0' *in50 C Z-ADD 1 hautpage14 c z-add 0 ligne14 4 0 c write lstctlvsoc c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c eval vvcherchsoc ='%'+%trim(vcherchsoc) + '%' c vcherchsoc ifeq *blank c goto vide2 c endif C/EXEC SQL declare recset2 cursor for C+ select tkaux,tknom,tkpays C+ from robttt C+ where tknom like :vvcherchsoc C+ and tkseq = 'CLIENT' C/END-EXEC c* C/EXEC SQL open recset2 C/END-EXEC c z-add *zero ligne14sv 4 0 c chargvsoc tag c z-add ligne14sv ligne14 c z-add 0 cumul 4 0 c sqlstt doweq '00000' C/EXEC SQL fetch from recset2 into :ECcodvsoc,:EClibvsoc,:eccodvpay C/END-EXEC c sqlstt ifeq '00000' c add 1 ligne14 c add 1 cumul c z-add ligne14 ligne14sv c write lstVsoc c endif c enddo C/EXEC SQL close recset2 C/END-EXEC c vide2 tag c add 1 ligne14 c move *blank eccodvsoc c move *blank eclibvsoc c move *blank eccodvpay c write lstVsoc * detail - fin C Z-ADD 1 PAGAFF14 c exfmt lstctlVsoc c wsenrc chain lstVsoc 99 c *in99 ifeq '0' c move eccodvsoc crvcodsoc c endif c *in09 ifeq '1' c pshbtn9 oreq 9 c goto cherchvsoc c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Pays - Vendus (ordres) CSR listVpays BEGSR c move '0' *in50 C Z-ADD 1 hautpage13 c z-add 0 ligne13 4 0 c write lstctlvpay c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c move *blank rarg c recpays setll fan100p1 c read fan100p1 c dow rct = 'PY' c add 1 ligne13 c movel rarg eccodpays c movel tlib1 eclibpays c write lstVpay c read fan100p1 c enddo * detail - fin C Z-ADD 1 PAGAFF13 c exfmt lstctlVpay c wsenrc chain lstVpay 99 c *in99 ifeq '0' c move eccodpays crvcodpay c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS C* Recherche clients provisoires dans souclt CSR clientsouclt BEGSR c recsouclt chain soucltf1 99 c *in99 ifeq '0' c movel clnom eclibsoci c else c movel '1' Inconnu1 1 c endif C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS C* Recherche clients d‚finitif dans robttt CSR clientrobttt BEGSR c recclt chain robtttf1 99 c *in99 ifeq '0' c movel tknom eclibsoci c else c movel '1' Inconnu2 1 c endif C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste Famille CSR listFamille BEGSR c move '0' *in50 C Z-ADD 1 hautpage15 c z-add 0 ligne15 4 0 c write lstctlfam c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c movel '44' kpos c movel *blank kcle c recenr setll fourtof0 c read fourtof0 c dow fopos = '44' c add 1 ligne15 c move focle eccodfam c movel fozon1 eclibfam c write lstfam c read fourtof0 c enddo * detail - fin C Z-ADD 1 PAGAFF15 c exfmt lstctlfam c wsenrc chain lstfam 99 c *in99 ifeq '0' c move eccodfam crcodfam c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto crit c endif c goto crit C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS * Liste des Applications CSR listAppl BEGSR c CherchAppl tag c move '0' *in50 C Z-ADD 1 hautpage16 c z-add 0 ligne16 4 0 c write LstCtlAppl c move '1' *in50 c move '0' *in64 * fin ctl c*==================================================================== * detail c eval vCherchApp ='%'+%trim(vCherchApp) + '%' c* c ChargAppl tag c z-add 0 cumul 4 0 c cumul dowlt 10 c add 1 ligne16 c add 1 cumul c movel ligne16 ecCodAppl c write lstAppl c enddo * detail - fin C Z-ADD 1 PAGAFF16 c AffFich7 tag c exfmt lstctlAppl c wsenrcap chain lstAppl 99 c *in99 ifeq '0' c move eccodAppl crvcodsoc c endif c *in09 ifeq '1' c pshbtn9 oreq 9 c goto CherchAppl c endif c *in12 ifeq '1' c pshbtn12 oreq 12 c goto AffFich6 c endif c goto AffFich7 C ENDSR C*SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS ** Il n'y a aucune Fiche correspondant au critŠre G0010416 Il n'y a aucune Vente pour ce produit G002 Il n'y a aucun Support pour ce produit G003 Il n'y a aucun Statut pour ce produit G004 Il n'y a aucun Echantillon pour ce produit G005 Enregistr‚ G006 G007 G008 G009 G010