dcl iebgener ext entry options(asm inter retcode fetchable);/* Copy für sequentielle Files      */

/**
  * @description: Kopieren des sequentiellen Files des übergebenen
  *      Paketteiltyps falls dieser Paketteiltyp im Quellpaket
  *      vorkommt.
  * @param(*,IN): Paketteiltyp welches vom Quellpaket (Init|Delta) eins
  *      zu eins kopiert wird.                                        \\
  *                                                                   \\
  *      Wenn es sich beim Quellpaket um ein Delta Paket handelt wird
  *      NICHTS vom dazugehörigen Init Paket kopiert.
  * @return: Fehlercode (im Fehlerfall ist CERR immer gesetzt)        \\
  *      1 .... Paketteil nicht vorhanden oder nicht abgeschlossen    \\
  *      0 .... alles OK                                              \\
  *      -2 ... Datenbankfehler                                       \\
  *      -4 ... Dateifehler                                           \\
  */
 copy_packagepart_seqfile: proc(ptyp) returns(bin fixed(31));

   dcl ptyp char(8);

   dcl seqfile_counter  bin fixed(31) init(-1);
   dcl membercopy       char(8);

   loop_seqfile_copy: do forever;

     select(packagepart_contained_in_base_package(ptyp, seqfile_counter));
       when(0)
         /* Paketteil vom Typ verarbeiten */;
       when(1)
         /* kein (weiterer) Paketteil vom Typ vorhanden */
         return(1);
       otherwise do;
         cerr_ptr = put_cerr(setcerr,' >> '!!'SCA078070'!!'-');
         return(-2);
       end;
     end;

     /* Quell-DSN allocieren */
     bpxwdyn_cmd = 'ALLOC FI(SYSUT1) DA('!!trim(dsn.base_pk)!!') SHR';
     rc = call_bpxwdyn(trim(bpxwdyn_cmd));
     if(rc ^= 0) then do;
       cerr_ptr = put_cerr(setcerr,' >> '!!'SCA078071'!!'-');
       return(-4);
     end;

     /* Ziel-DSN allocieren */
     rc = delete_dataset(trim(dsn.sel_pk));  /* Löschen wenn Wiederholung wegen error */
     if(rc < 0) then do;
       cerr_ptr = put_cerr(setcerr,' >> '!!'SCA078072'!!'-');
       noo_status.info = trim(ptyp)!!'-DEL-ALLOC error';
       call bpxwdyn('free fi(SYSUT1)');
       return(-4);
     end;
     bpxwdyn_cmd = 'ALLOC FI(SYSUT2) DA('!!trim(dsn.sel_pk)!!') '!!
                   'NEW CATALOG REUSE UNIT(DISK) ';
     ipos = index(dsn.base_pk,'(');
     if ipos > 0 then do;
       bpxwdyn_cmd !!= 'like('!!substr(dsn.base_pk,1,ipos-1)!!') ';
       membercopy = trim(substr(dsn.base_pk,ipos+1),'',' )');
     end;
     else do;
       bpxwdyn_cmd !!= 'like('!!trim(dsn.base_pk)!!') ';
       membercopy = '';
     end;
     rc = call_bpxwdyn(bpxwdyn_cmd);
     if(rc ^= 0) then do;
       cerr_ptr = put_cerr(setcerr,' >> '!!'SCA078073'!!'-');
       call bpxwdyn('free fi(SYSUT1)');
       return(-4);
     end;

     /* Kopieranweisungen initialisieren */
     iebcin_undf = boolean_const.false;
     open file(iebcin) title('SYSIN');
     if iebcin_undf then do;
       /* SCM-Agent hat SYSIN bereits allokiert - User muss bei einer Durchführung via
          Test-Interface explizit allokieren */
       if alloc_sysin() ^= 0 then do;
         call bpxwdyn('free fi(SYSUT1)');
         call bpxwdyn('free fi(SYSUT2)');
         noo_status.info = 'SYSIN-'!!trim(ptyp)!!' alloc-err';
         return(-4);
       end;
       iebcin_undf = boolean_const.false;
       open file(iebcin) title('SYSIN');
     end;
     if membercopy ^= '' then do;
       iebcin_fld = ' COPY OUTDD=SYSUT2,INDD=SYSUT1';
       write file(iebcin) from(iebcin_fld);
       iebcin_fld = ' SELECT MEMBER=(('!!trim(membercopy)!!',,R))';
       write file(iebcin) from(iebcin_fld);
       close file(iebcin);
       call iebcopy();
       if(pliretv ^= 0) then do;
         /**
          * @explanation: Beim Kopieren der Membern von Datei bbb auf
          *      Datei ccc ist ein Fehler aaa aufgetreten. Das IEBCOPY-
          *      Protokoll (ddd) enthält genaue Details. Die
          *      Verarbeitung kann nicht fortgesetzt werden.
          * @response: IEBCOPY-Protokoll prüfen und dementsprechend den
          *      Fehler beheben.
          */
         cerr_ptr = sys_error('SCA0780150','Fehler ' !! hex(pliretv) !! '" beim Kopieren von "'
            !! trim(dsn.base_pk) !! '" auf "' !!trim(dsn.sel_pk),setcerr);
         call bpxwdyn('free fi(SYSUT1)');
         call bpxwdyn('free fi(SYSUT2)');
         return(-4);
       end;
     end; /* membercopy */
     else do;
       close file(iebcin); /* SYSIN File leer >> Open nur um zu prüfen ob es allociert ist! */
       call iebgener();
       if(pliretv > 4) then do;
         /**
          * @explanation: Beim Kopieren der Membern von Datei bbb auf
          *      Datei ccc ist ein Fehler aaa aufgetreten. Das IEBCOPY-
          *      Protokoll (ddd) enthält genaue Details.* Die
          *      Verarbeitung kann nicht fortgesetzt werden.
          * @response: IEBCOPY-Protokoll prüfen und dementsprechend den
          *      Fehler beheben.
          */
         cerr_ptr = sys_error('SCA078074','Fehler ' !! hex(pliretv) !! '" beim Kopieren mittels '!!
           'IEBGENER  vom sequentiellen File "'!! trim(dsn.base_pk) !! '" auf "' !!trim(dsn.sel_pk),
           setcerr);
         call bpxwdyn('free fi(SYSUT1)');
         call bpxwdyn('free fi(SYSUT2)');
         return(-4);
       end;
       /* jede weitere IEBGENER Verwendung hat Probleme -> immer wieder freigeben
          (laut Rückfrage Elderon die Lösung des Problems) */
       release iebgener;
     end;

     rc = call_bpxwdyn('free fi(SYSUT1)');
     if(rc ^= 0) then do;
       cerr_ptr = put_cerr(setcerr,' >> '!!'SCA078075'!!'-');
       call bpxwdyn('free fi(SYSUT2)');
       return(rc);
     end;
     rc = call_bpxwdyn('free fi(SYSUT2)');
     if(rc ^= 0) then do;
       cerr_ptr = put_cerr(setcerr,' >> '!!'SCA078076'!!'-');
       return(rc);
     end;

   end; /* loop_seqfile_copy */