Alimentation auto des zones d'un fichier dans un source GAP III






Commande de lancement et de saisie des paramètres (QCMDSRC)
        **************  Début des données  **************************************
0001.00              CMD        PROMPT('Alimentation des cartes C')              
0002.00                                                                          
0003.00              PARM       KWD(FIC) TYPE(*CHAR) LEN(10) PROMPT('Fichier +   
0004.00                           concerné')                                     
0005.00                                                                          
0006.00                                                                          
0007.00              PARM       KWD(BIB) TYPE(*CHAR) LEN(10) +                   
0008.00                           PROMPT('Bibliothèque du fichier')              
0009.00                                                                          
0010.00                                                                          
0011.00              PARM       KWD(TRT) TYPE(*CHAR) LEN(5) RSTD(*YES) +         
0012.00                           VALUES(*INIT *MOVE *RENA) PROMPT('Mode de +    
0013.00                           traitement')                                   
0014.00                                                                          
        ***************  Fin des données  ***************************************


CL de préparation du traitement - substitution (QCLSRC)


        **************  Début des données  **************************
0001.00              PGM        PARM(&FIC &BIB &TRT)                 
0002.00                                                              
0003.00                                                              
0004.00              DCL        VAR(&FIC) TYPE(*CHAR) LEN(10)        
0005.00              DCL        VAR(&BIB) TYPE(*CHAR) LEN(10)        
0006.00              DCL        VAR(&TRT) TYPE(*CHAR) LEN(5)         
0007.00                                                              
0008.00                                                              
0009.00   /*   CREATRION DU FICHIER SOURCE      */                   
0010.00              CRTSRCPF   FILE(QTEMP/RPG) RCDLEN(92) MBR(RPG)  
0011.00              MONMSG     MSGID(CPF0000)                       
0012.00                                                              
0013.00                                                              
0014.00  /*  SORTIE DE DSPFFD SUR LE FICHIER     */                  
0015.00                                                              
0016.00              DSPFFD     FILE(&BIB/&FIC) OUTPUT(*OUTFILE) +   
0017.00                           OUTFILE(QTEMP/IMPFFD)              
0018.00              MONMSG     MSGID(CPF0000)                       
0019.00                                                              
0020.00              CALL       PGM(ALIMRPG)   PARM(&TRT)           
0021.00                                                              
0022.00    ENDPGM                                                    
        ***************  Fin des données  ***************************


Programme RPG IV (ALIMRPG) qui fabrique un source avec les zônes alimentées


        **************  Début des données  ********************
0001.00 H DECEDIT('0,') DATEDIT(*YMD)                          
0002.00 FIMPFFD    IP   E           K DISK                     
0003.00 FRPG       IF A E           K DISK    RENAME(RPG:RPGF) 
0004.00 D******************************************************
0005.00 F*                                                     
0006.00 D                 DS                                   
0007.00 D  WRKSRCDTA              1     80                     
0008.00 D  COULEUR                5      5                     
0009.00 D  CARTE_C                6      6                     
0010.00 D  FORMAT                 7     16                     
0011.00 D  CODOPERATION          28     32                     
0012.00 D  REN_FROM              21     26                     
0013.00 D  REN_TO                53     58                     
0014.00 D  FACTEUR2              33     38                     
0015.00 D  FACTEUR3              43     48                     
0016.00 D  COMMENTAIRE           60     74                     
0017.00  * Structure de données des erreurs programmes SDS     
0018.00 D                SDS                                   
0019.00 D  PGM                    1     10                     
0020.00 D  USER                 254    263                     
0021.00                                                        
0022.00  *=====================================================
0023.00 C     *ENTRY        PLIST                              
0024.00 C                   PARM                    TRAITEMENT        5           
0025.00  *                                                                        
0026.00 C                   CLEAR                   WRKSRCDTA                     
0027.00 C                   IF        TRAITEMENT='*INIT' OR TRAITEMENT = '*MOVE'  
0028.00 C                   MOVEL     'C'           CARTE_C                       
0029.00 C*                       
0030.00 C                   MOVEL     WHFLDI        FACTEUR3                      
0031.00 C                   MOVEL     WHFTXT        COMMENTAIRE                   
0032.00 C                   ENDIF                                                 
0033.00                                                                           
0034.00                                                                           
0035.00 C                   IF        TRAITEMENT = '*INIT'                        
0036.00  *                  initialisation numérique                              
0037.00 C                   IF        WHFLDD > 0                                  
0038.00 C                   MOVEL     'Z-ADD'       CODOPERATION                  
0039.00 C                   MOVEL     '0     '      FACTEUR2                      
0040.00  *                  initialisation alphanumérique                         
0041.00 C                   ELSE                                                  
0042.00 C                   MOVEL     'MOVEL'       CODOPERATION                  
0043.00 C                   MOVEL     '*BLANKS'     FACTEUR2                      
0044.00 C                   ENDIF                                                 
0045.00 C                   ENDIF                                                 
0046.00  *                                                                        
0047.00                                                                           
0048.00 C                   IF        TRAITEMENT = '*MOVE'         
0049.00 C                   MOVEL     WHFLDI        FACTEUR2       
0050.00 C                   IF        WHFLDD > 0                   
0051.00 C                   MOVEL     'Z-ADD'       CODOPERATION   
0052.00  *                  initialisation alphanumérique          
0053.00 C                   ELSE                                   
0054.00 C                   MOVEL     'MOVEL'       CODOPERATION   
0055.00 C                   ENDIF                                  
0056.00 C                   ENDIF                                  
0057.00                                                            
0058.00 C                   IF        TRAITEMENT= '*RENA'          
0059.00 C                   MOVEL     'I'           CARTE_C        
0060.00 C*        
0061.00 C                   MOVEL     WHFLDI        REN_FROM       
0062.00 C                   MOVEL     WHFLDI        REN_TO         
0063.00 C                   MOVEL     'Z'           REN_TO         
0064.00 C                   ENDIF                                  
0065.00                                                            
0066.00                                                            
0067.00 C                   ADD       1             SRCSEQ         
0068.00 C                   Z-ADD     UDATE         SRCDAT         
0069.00 C                   MOVEL     WRKSRCDTA     SRCDTA         
0070.00 C                   WRITE     RPGF                         
0071.00  *