Exemple de gestion de sous-fichier en SQL

 **FREE

// Programme: FOURN01R - Gestion liste des fournisseurs

// Description: Sous-fichier dynamique pour gérer les fournisseurs

// F6=Créer  Opt2=Modifier  Opt4=Supprimer

Ctl-Opt DftActGrp(*No) ActGrp(*Caller) Option(*SrcStmt:*NoDebugIO);

Dcl-F FOURN01D WorkStn Sfile(SFL:RRN) IndDs(Ind) UsrOpn;

// =========================================================================

// INCLUSION DES PROTOTYPES PARTAGÉS

// =========================================================================

/INCLUDE '/includes/prototypes.rpgleinc'

// Indicateurs

Dcl-Ds Ind;

  Fin Ind Pos(3);

  Refresh Ind Pos(5);

  Creer Ind Pos(6);

  Retour Ind Pos(12);

  SflDsp Ind Pos(91);

  SflDspCtl Ind Pos(92);

  SflClr Ind Pos(93);

  SflEnd Ind Pos(94);

End-Ds;

// Variables globales

Dcl-S RRN Zoned(4:0);

Dcl-S OldFiltre Char(30);

Dcl-S PageSize Int(10) Inz(15);

Dcl-S LastCode Int(10) Inz(0);

Dcl-S FinLecture Ind Inz(*Off);

// Variables SQL

Dcl-S SqlCode Int(10);

Dcl-S SqlState Char(5);

Exec SQL Set Option Commit = *None, CloSqlCsr = *EndMod;

Exec SQL Declare C1 Cursor For

  Select CODE, SOCIETE,

         Char(DATE_CREATION, ISO) as DATCRT,

         Char(DATE_MODIFICATION, ISO) as DATMAJ

  From FOURNISSEUR

  Where SUPPRESSION = '0'

    And (SOCIETE Like :Filtre Or :Filtre = ' ')

    And CODE > :LastCode

  Order By CODE

  Fetch First :PageSize Rows Only;

// Programme principal

Open FOURN01D;

OldFiltre = *Blanks;

Filtre = *Blanks;

ChargerSousfichier();

DoU Fin or Retour;

  Write FOOTER;

  ExFmt SFLCTL;

 

  If Fin or Retour;

    Leave;

  EndIf;

 

  // F6 = Créer un nouveau fournisseur

  If Creer;

    FOURN02R('C':0);

    ChargerSousfichier();

    Iter;

  EndIf;

 

  If Refresh or (Filtre <> OldFiltre);

    OldFiltre = Filtre;

    ChargerSousfichier();

    Iter;

  EndIf;

 

  TraiterOptions();

  ChargerSousfichier();

EndDo;

Close FOURN01D;

*InLr = *On;

Return;

// Procédure: Charger le sous-fichier

Dcl-Proc ChargerSousichier;

  SflClr = *On;

  SflDspCtl = *On;

  Write SFLCTL;

  SflClr = *Off;

 

  RRN = 0;

  LastCode = 0;

  FinLecture = *Off;

  SflEnd = *Off;

 

  Exec SQL Open C1;

 

  DoU FinLecture;

    Exec SQL Fetch C1 Into :CODE, :SOCIETE, :DATCRT, :DATMAJ;

   

    If SqlCode = 100 or SqlCode < 0;

      FinLecture = *On;

      SflEnd = *On;

      Leave;

    EndIf;

   

    RRN += 1;

    OPT = *Blanks;

    Write SFL;

    LastCode = CODE;

   

    If RRN >= PageSize;

      Leave;

    EndIf;

  EndDo;

 

  Exec SQL Close C1;

 

  If RRN > 0;

    SflDsp = *On;

  Else;

    SflDsp = *Off;

  EndIf;

 

  SflDspCtl = *On;

End-Proc;

// Procédure: Traiter les options du sous-fichier

Dcl-Proc TraiterOptions;

  Dcl-S i Zoned(4:0);

  Dcl-S Reponse Char(1);

  Dcl-S Message Char(50);

 

  For i = 1 To RRN;

    Chain i SFL;

   

    If %Found() and OPT <> *Blanks;

      Select;

        // Option 2 = Modifier

        When OPT = '2';

          FOURN02R('M':CODE);

          OPT = *Blanks;

          Update SFL;

         

        // Option 4 = Supprimer

        When OPT = '4';

          Message = 'Voulez-vous supprimer le fournisseur ' +

                    %Trim(SOCIETE) + ' ?';

          CONFIRMER(Message:Reponse);

         

          If Reponse = 'O';

            Exec SQL Update FOURNISSEUR

                     Set SUPPRESSION = '1',

                     DAT_MAJ = Current_Date

                     Where CODE = :CODE;

          EndIf;

         

          OPT = *Blanks;

          Update SFL;

         

        // Option 8 = Voir les produits

        When OPT = '8';

          PRODUIT1R(CODE);

          OPT = *Blanks;

          Update SFL;

         

        // Option invalide

        Other;

          OPT = *Blanks;

          Update SFL;

      EndSl;

    EndIf;

  EndFor;

End-Proc;