© serviceprofessionalgmbh

This central program is used for diverse functions dealing with PO data sets. The processing of the various functions takes place via ISPF services. Compared to their TSO equivalents they are better and quicker in many areas. For instance, a member can only be erased with the TSO DELETE command when TSO manages to assign the whole data set exclusively at the time of deletion (DELETE allocates the data set with option OLD, even if only one member of it is supposed to be deleted). Often this is simply not possible for heavily frequented data sets.


How to use
DATEI = "SPGMBH.TEST.DATA"
mbr_list = PDS$E(DATEI,"MBRLST")        /* chain of words with membernames */
mbr_list = PDS$E(DATEI,"MBRLST","AB*")  /* chain of words with membernames starting with AB */




/* REXX * PDS$E ******************************************************
*                                                                    *
*  Funktion: Diverse Funktionen mit PO-Dateien und Mitgliedern       *
*  Parms...: 1. Name der PO-Datei                                    *
*            2. Funktion                                             *
*               BROWSE = Anzeigen via BROWSE                         *
*               COPY   = Kopieren MBR1 nach MBR2                     *
*               MOVE   = uebertragen MBR1 nach MBR2                  *
*               EDIT   = Editieren                                   *
*               DEL    = Loeschen MBR1                               *
*               MBRLST = Mitgliederliste als Wortkette               *
*               VIEW   = Anzeigen via VIEW                           *
*            3. Mbr1 (optional)                                      *
*            4. Mbr2 (optional)                                      *
*            5. Name der PO-Datei COPY/MOVE wenn nicht PARM1 (opt.)  *
*                                                                    *
*********************************************************************/

parse source . PGMTYP PUAKTCMD .
if PGMTYP = "FUNCTION" then arg DSN1,FUNKTION,MBR1,MBR2,DSN2,DUMMY
else                        arg DSN1 FUNKTION MBR1 MBR2 DSN2 .
address ispexec
"control errors return"
"vget (TRACE) shared"
if wordpos(TRACE,"ON ALL YES") > 0 ! ,
   wordpos(PUAKTCMD,TRACE)  > 0 then trace ?r
DMY = msg("OFF")

HPROG_START:
      PUAKTRC  = 0
      PUAKTERG = ""
      select
         when FUNKTION = "BROWSE" then call braus_vjuh_edit "BROWSE"
         when FUNKTION = "EDIT"   then call braus_vjuh_edit "EDIT"
         when FUNKTION = "VIEW"   then call braus_vjuh_edit "VIEW"
         when FUNKTION = "COPY"   then call copy_move "COPY"
         when FUNKTION = "MOVE"   then call copy_move "MOVE"
         when FUNKTION = "DEL"    then call loeschen
         when FUNKTION = "MBRLST" then call memberlist
         otherwise PUAKTRC = 12
      end
HPROG_ENDE:

PULSTCMD = PUAKTCMD
PULSTRC  = PUAKTRC
PULSTERG = PUAKTERG
"vput (PULSTERG PULSTRC PULSTCMD PUAKTERG PUAKTRC PUAKTCMD)"

if PGMTYP = "COMMAND" then exit PUAKTRC
else return PUAKTERG

/*********************************************************************
* Allgemeine Subroutinen                                             *
*********************************************************************/

braus_vjuh_edit:
      /***************************************************************
      * Memberanzeige oder Dateianzeige mit Browse                   *
      ***************************************************************/
      arg ANZEIGE_TYP .
      if MBR1 <> "" then DSN1 = DSN1"("MBR1")"
      "control display save"
      interpret '"'ANZEIGE_TYP "dataset('&DSN1'"')"'
      PUAKTRC = RC
      "control display restore"
return

copy_move:
      /***************************************************************
      * Kopieren/uebertragen MBR1 nach MBR2 in DSN1 (oder DSN2)      *
      ***************************************************************/
      arg FUNKTION .
      if strip(DSN2) = "" then DSN2 = DSN1
      if strip(MBR2) = "" then MBR2 = MBR1
      if DSN1 = DSN2 & MBR1 = MBR2 then return
      "lminit dataid(DID1) dataset('&DSN1') enq(shrw) org(po)"
      "lminit dataid(DID2) dataset('&DSN2') enq(shrw) org(po)"
      "lmcopy fromid(&DID1) frommem(&MBR1)",
          "todataid(&DID2) tomem(&MBR2) replace"
      "lmfree dataid(&DID1)"
      "lmfree dataid(&DID2)"
      if FUNKTION = "MOVE" then call loeschen
return

loeschen:
      /***************************************************************
      * Delete Member aus PO-Datei                                   *
      ***************************************************************/
      "lminit dataid(DID) dataset('&DSN1') enq(shrw)"
      "lmopen dataid(&DID) option(output) org(po)"
      "lmmdel dataid(&DID) member(&MBR1)"
       PUAKTRC = RC
      "lmclose dataid(&DID)"
      "lmfree dataid(&DID)"
return

memberlist:
      /***************************************************************
      * Ermitteln Memberliste                                        *
      ***************************************************************/
      if pos('*',mbr1) = 0 then mbr1 = strip(left(mbr1'*',8))
      "lminit dataid(did) dataset('&DSN1') enq(shr) org(po)"
      "lmopen dataid(&DID) option(input)"
      PUAKTRC = RC
      "lmmlist dataid(&DID) option(list) member(MBR) pattern(&mbr1)"
      do while RC = 0
         PUAKTERG = PUAKTERG strip(MBR)
         "lmmlist dataid(&DID) option(list) member(MBR) pattern(&mbr1)"
      end
      "lmclose dataid(&DID)"
      "lmfree dataid(&DID)"
return
back to REXX with ISPF