F*==============================================================*
* Auteur : JMD Le XX/XX/XXXX *
* ------ *
*==============================================================*
* Libellé : XXXXXXXXXXXXXXXXXXXXX *
* ------- *
*===============================================================
* Description / deroulement XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *
* ------------------------- XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *
* *
*===============================================================
* Modifications du SRC *
*--------!--------!----------------------------------- --------*
* N°modif! Date !Description Auteur *
* M01 !XX/XX/XX!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXX *
* ! !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *
*--------!--------!----------------------------------- --------*
*===============================================================
* FICHIERS UTILISES *
* ***************** *
* - xxxxxxxxxx ---> Tarifs : Mise à jour *
* - xxxxxxxxxx ---> Adresse : Lecture *
*==============================================================*
* Redéfinition d'un format écran.
FSTOCK2PXO E DISK
F STOCK2F0 KRENAMESTOCK2FX
FCLIENTP1IF E K DISK
FCLIENTPXIF E DISK
*
E OH 1 5 15
* Stockage des actes émis.
E ACT 20 5
* Données d'entete
ICLIENTF0
I CLIENT $CLIEN
I RAISOC $RAISO
* ================= *
* DS INTERNES *
* ================= *
* Découpage de la Dtaara.
IINFOVA DS 27
I 1 4 SACHA
I 5 9 CODFO
I 10 14 NLOT
I 15 26 CTRAC
I 27 27 CODE
I DS
I 1 120HMSJMA
I 1 60£HEURE
I 7 80£HEU
I 9 100£MIN
I 11 120£SEC
I 7 120£DATE
I 7 80£JJ
I 9 100£MM
I 11 120£AA
*
ICLIPX E DSCLIENTPX
ISAVPX DS 1024
*
I SDS
I 1 10 £PGM
I 244 253 £JOB
I 254 263 £USR
I 264 2690£NBR
*
* DSDSP - Display file feedback area
IDSDSP E DSCDSDSP
*
* DSPST - Program status data structure
I ESDSCDSPST
*
* DSLDA - Movex Local Data Area (QTEMP/MVXLDA)
IDSLDA E DSCDSLDA 2000
*
* ================================= *
* I N I T I A L I S A T I O N *
* ================================= *
* Réception paramètres
*---------------------
C *ENTRY PLIST
C PARM PSTEC 2
* Définition des zones de travail
*--------------------------------
C *LIKE DEFN NUMCOM WUMCOM
C *LIKE DEFN ENCOU1 MONT + 4
* Définition des clés de fichier
*-------------------------------
C £KEY1 KLIST
C KFLD STE
C KFLD DIV
* ========================================= *
* C O R P S D U P R O G R A M M E
* ========================================= *
* Formatage date AA/MM/JJ avec TIME de départ JJ/MM/A
C TIME HMSJMA
C MOVE £DATE WAMJ 6
C MOVEL£AA WAMJ
C MOVE £JJ WAMJ
*
* Exemple de boucle structuré FAIRE TANT QUE...
C £KEY2 SETLLNOMVALL2
C £KEY2 READENOMVALL2 12
C *IN12 DOWEQ*OFF <--
C EXSR CRTLIG
C MOVE *OFF *IN12
C £KEY2 READENOMVALL2 12
C N12 ENDDO <--
*
* Mise à jour d'un DTAARA
C *NAMVAR DEFN INFOVA
C *LOCK IN INFOVA
C MOVELWSACHA SACHA P
C MOVELWCODFO CODFO P
C MOVELWNLOT NLOT P
C MOVELWCTRAC CTRAC P
C MOVELWCODE CODE P
C OUT INFOVA
C UNLCKINFOVA
* ======= *
* TABLEAU *
* ======= *
* Stockage des actes émis.
C Z-ADD0 C1 30
C Z-ADD1 $Z 30
C BZMESS LOKUPACT,$Z 95
C *IN95 IFEQ '0' <--
C ADD 1 C1
C MOVELBZMESS ACT,C1
C ENDIF <--
*
* Soumission traitement d'extraction
* ----------------------------------
C Z-ADD1 £J 30
C DO C1 £J <--
C MOVELACT,£J R3ACTE P
C ENDDO <--
*
* ==================================================
* Extraction d'une zone
* facteur 1 = longueur d'extraction, facteur 2 = Nom
* et point de départ de l'extraction, facteur3 = zone
* Ex: Nom = 'ABCDEFGH' => RESULT = 'BCDEF'
*
C 5 SUBSTNOM:2 RESULT
*
* ==================================================
* Concaténation d'une zone
* si ':0' => pas de blanc entre les deux zones.
* si ':1' => 1 blanc entre les deux zones.
*
C PNOM CAT PRENOM:0 RESULT
*
* ====================================== *
* Recherche du 1er blancs et suppression *
* ====================================== *
*
C *LIKE DEFN COMPAR DEBCOM
C *LIKE DEFN COMPAR FINCOM
*
C ' ' SCAN COMPAR WPOS 20 50
C *IN50 IFEQ '1' <--
C WPOS ANDNE12 <
C COMPAR ANDNE*BLANK <
C MOVE *BLANK DEBCOM
C MOVE *BLANK FINCOM
C MOVE *BLANK TCPTE
C 12 SUB WPOS L 20
C WPOS SUB 1 WPOS
C WPOS SUBSTCOMPAR:1 DEBCOM
C WPOS ADD 2 T
C L SUBSTCOMPAR:T FINCOM
C DEBCOM CAT FINCOM:0 TCPTE
C ELSE
C MOVELCOMPAR TCPTE
C END <--
*
* ====================== *
* Remise à blanc d'un DS *
* ====================== *
* Sauvegarde de la DS du ficher CLIENTPX
C CLEARSAVPX
C MOVELCLIPX SAVPX
*
* =============================== *
* S O U S R O U T I N E S *
* =============================== *
*
* ====================== *
* DONNEES D'ENTETE *
* ====================== *
C R134H1 BEGSR
* ====== =====
*
C ENDSR
* =====