         START                                                                  
* -----------------------------------------------------------------             
         DC   C'<< Revive ! : Dynamic Allocation >> ('                          
         COPY RV1#HDR                                                           
         PRINT NOGEN                                                            
* --- Start of Process --------------------------------------------             
* RC                                                                            
*    0 : OK                                                                     
*    1 : Dynamic Allocation Error                                               
*    8 : Dataset Not Found on Specified Volume                                  
*   16 : Process Not Defined.                                                   
*                                                                               
         PRINT NOGEN                                                            
RV1DALC  AMODE 31                                                               
RV1DALC  RMODE ANY                                                              
RV1DALC  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03,R04,R05             Base Reg. R03,R04,R05                  
         LA    R04,2048(R03)             2'ND Base Reg                          
         LA    R04,2048(R04)                                                    
         LA    R05,2048(R04)             3'ND Base Reg                          
         LA    R05,2048(R05)                                                    
         ST    R13,SAVEAREA+4            Save A(OLD SaveArea)                   
         LR    R12,R13                                                          
         LA    R13,SAVEAREA                                                     
         ST    R13,8(R12)                Save A(NEW SaveArea)                   
*-------- Parameter Process ----------------------------------------            
         LR    R12,R01                                                          
         USING RV1ALCD,R12                                                      
         CLC   DA#DISP,=CL3'FRE'         Free Process                           
         BE    @DY_FRE                                                          
         CLC   DA#DISP,=CL3'NEW'         Creation Process                       
         BE    @DY_CRE                                                          
         CLC   DA#DISP,=CL3'OLD'         Allocation ( Exclusive Enq )           
         BE    @DY_ALC                                                          
         CLC   DA#DISP,=CL3'SHR'         Allocation ( Share Enq )               
         BE    @DY_ALC                                                          
         CLC   DA#DISP,=CL3'MOD'         Modification ( Exc Enq )               
         BE    @DY_ALC                                                          
         LA    R15,16                    Undefined Operation Code               
         B     @BYE                                                             
MVDA#ERR MVC   DA#ERR(0),@D_MES01                                               
*-------- Dynamic Allocation ( Allocate ) --------------------------            
@DY_ALC  EQU   *                                                                
         XC    RBAREA,RBAREA             Zero Clear RB Area                     
         LA    R11,RBAREA                R11 <- RB Area Base                    
         USING S99RB,R11                                                        
*                                                                               
         XC    RBXAREA,RBXAREA           Zero Clear RBX Area                    
         LA    R10,RBXAREA               R10 <- RBX Area Base                   
         USING S99RBX,R10                                                       
* RB Area Setup ...                                                             
         MVI   S99RBLN,RBLEN             RB Length                              
         MVI   S99VERB,S99VRBAL          RB Verb (Dataset Name Alloc)           
         LA    R06,S99RB+RBLEN           Text Units Address                     
         ST    R06,S99TXTPP                                                     
         ST    R10,S99S99X               Request Block Extended Address         
* RBX Area Setup ...                                                            
         MVC   S99EID,=CL6'S99RBX'       RBX ID                                 
         MVI   S99EVER,S99RBXVR          Version Code                           
         OI    S99EOPTS,S99ELSTO         Process Option                         
         OI    S99EOPTS,S99ERMSG         Process Option                         
         OI    S99EMGSV,S99XINFO         Retern to Information                  
* --- Text Units Setup ----------------------------------------------           
* R06 <- Text Units Current Wrtite Point .                                      
* --- Dataset Name ---                                                          
         MVC   ALCDSN(44),DA#DSN         Copy to Dataset Name                   
         LA    R01,@D_DSN                Load DSN Parm Address                  
         ST    R01,0(R06)                  Store it                             
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- volume serial ---                                                         
         CLI   DA#VOL,C' '               If Volume Serial Is Space              
         BE    @DY_VOL                     goto @DY_VOL                         
         MVC   W#DSN(44),DA#DSN          Copy Dataset Name to JFCB              
         MVC   W#VOL(6),DA#VOL           Copy Volume Serial to JFCB             
         XC    DSCB,DSCB                 Clear DSCB                             
         OBTAIN DSCBFMT1                 Get DSCB1                              
         LTR   R15,R15                   If No Error                            
         BZ    @DY_VOL1                    goto @DY_VOL1                        
         LA    R01,L'@D_MES01            Set Error Message                      
*        STC   R01,*+5                                                          
*        MVC   DA#ERR(0),@D_MES01                                               
         EX    R01,MVDA#ERR                                                     
         LA    R15,8                     Error Code = 8                         
         B     @BYE                      Return                                 
@DY_VOL1 EQU   *                                                                
         MVC   ALCVOL(06),DA#VOL         Copy Volume Serial                     
         LA    R01,@D_VOL                Load VOL Parm Address                  
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
@DY_VOL  EQU   *                                                                
* --- disp ---                                                                  
* old                                                                           
         CLC   DA#DISP,=CL3'OLD'         If Not Disp = OLD                      
         BNE   @DY_DOLD                    goto @DY_DOLD                        
         LA    R01,@D_DOLD               Load DISP=OLD Address                  
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
         B     @DY_DEXT                                                         
@DY_DOLD EQU   *                                                                
* mod                                                                           
         CLC   DA#DISP,=CL3'MOD'         If Not Disp = MOD                      
         BNE   @DY_DMOD                    goto @DY_DMOD                        
         LA    R01,@D_DMOD               Load DISP=MOD Address                  
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
         B     @DY_DEXT                                                         
@DY_DMOD EQU   *                                                                
* shr                                                                           
         LA    R01,@D_DSHR               Load DISP=SHR Address                  
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
@DY_DEXT EQU   *                                                                
* --- unit ---                           UNIT=SYSALLDA Only                     
         LA    R01,@D_UNIT               Load Unit address                      
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- dd name ---                                                               
         LA    R01,@D_RETDD              Load Return DD Name Parm               
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- dataset organization ---                                                  
         LA    R01,@D_RETOR              Load Return DSORG Parm                 
         O     R01,=X'80000000'          Set End of Parameter List Mark         
         ST    R01,0(R06)                  and Store it                         
* --- end of parameter list ---                                                 
         DROP  R11,R10                                                          
         ST    R11,RBPAREA               Load SVC 99 Parm Address               
         OI    RBPAREA,S99RBPND                                                 
         LA    R01,RBPAREA                                                      
         SVC   99                        Dynamic Allocate                       
         LTR   R15,R15                   If Allocation OK ?                     
         BNZ   @DY_ERROR_PROC              goto @DY_OK                          
*-------------------------------------------------------------------            
         MVC   DA#RETDD(8),ALCDD         Set Returnd DD Name                    
*        ST    R12,WK#F                                                         
*        CALL  RV1BTH,(WK#F,WK#MES+10,4)                                        
*        LA    R01,DA#RETDD                                                     
*        ST    R01,WK#F                                                         
*        CALL  RV1BTH,(WK#F,WK#MES+20,4)                                        
*        TPUT  WK#MES,80                                                        
*        LA    R01,DA#RETDD                                                     
*        TPUT  (R01),8                                                          
*        TPUT  ALCDD,8                                                          
         MVC   DA#DSORG(2),ALCORG        Set Returnd DSORG                      
         MVC   DA#RETC(4),ALLOCER        Set Returnd Reanon Code                
*        TPUT  =CL60'*** ok ok ok ***',60                                       
         LA    R15,0                     Error Code = 0                         
         B     @BYE                      Return                                 
WK#F     DS    F                                                                
WK#MES   DC    CL80' '                                                          
*-------------------------------------------------------------------            
*-------- Dynamic Allocation ( Allocate ) --------------------------            
@DY_CRE  EQU   *                                                                
         XC    RBAREA,RBAREA             Zero Clear RB Area                     
         LA    R11,RBAREA                R11 <- RB Area Base                    
         USING S99RB,R11                                                        
*                                                                               
         XC    RBXAREA,RBXAREA           Zero Clear RBX Area                    
         LA    R10,RBXAREA               R10 <- RBX Area Base                   
         USING S99RBX,R10                                                       
* RB Area Setup ...                                                             
         MVI   S99RBLN,RBLEN             RB Length                              
         MVI   S99VERB,S99VRBAL          RB Verb (Dataset Name Alloc)           
         LA    R06,S99RB+RBLEN           Text Units Address                     
         ST    R06,S99TXTPP                                                     
         ST    R10,S99S99X               Request Block Extended Address         
* RBX Area Setup ...                                                            
         MVC   S99EID,=CL6'S99RBX'       RBX ID                                 
         MVI   S99EVER,S99RBXVR          Version Code                           
         OI    S99EOPTS,S99ELSTO         Process Option                         
         OI    S99EOPTS,S99ERMSG         Process Option                         
         OI    S99EMGSV,S99XINFO         Retern to Information                  
* --- Text Units Setup ----------------------------------------------           
* --- dataset name ---                                                          
         MVC   ALCDSN(44),DA#DSN         Copy Dataset Name                      
         LA    R01,@D_DSN                Load DSN Parm Address                  
         ST    R01,0(R06)                  and Store it                         
*                                                                               
*        L     R01,0(R06)                                                       
*        CALL  RV1BTH,((R01),WK#MES+05,30)                                      
*        TPUT  WK#MES,80                                                        
*        L     R01,0(R06)                                                       
*        LA    R01,20(R01)                                                      
*        CALL  RV1BTH,((R01),WK#MES+05,30)                                      
*        TPUT  WK#MES,80                                                        
*                                                                               
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- volume serial ---                                                         
         CLI   DA#VOL,C' '               If Volume Serial is Space              
         BE    @CR_VOL                     goto @CR_VOL                         
         MVC   ALCVOL(06),DA#VOL         Copy Volume Serial                     
         LA    R01,@D_VOL                Load Volume Serial Parm                
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
@CR_VOL  EQU   *                                                                
* --- disp 1 ---                                                                
* new                                                                           
         LA    R01,@D_DNEW               Load DISP=NEW Address                  
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- disp 2 ---                                                                
         LA    R01,@D_CTLG               Load DISP=(?,CATLG) Address            
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- space ---                                                                 
         CLC   DA#SPC(3),=CL3'CYL'       If CYL Alloc                           
         BE    @CR_DNE1                    goto @CR_DNE1                        
         CLC   DA#SPC(3),=CL3'TRK'       If TRK Alloc                           
         BE    @CR_DNE2                    goto @CR_DNE2                        
         XC    ALCBLK,ALCBLK             SPACE=(nnnn, ...  Block Alloc          
         MVC   ALCBLK+1(2),DA#BLKSZ      Copy Block Size                        
         LA    R01,@D_SBLK                                                      
         B     @CR_DNE3                                                         
@CR_DNE1 EQU   *                         SPACE=(CYL, ...                        
         LA    R01,@D_SCYL                                                      
         B     @CR_DNE3                                                         
@CR_DNE2 EQU   *                                                                
         LA    R01,@D_STRK               SPACE=(TRK, ...                        
@CR_DNE3 EQU   *                                                                
         ST    R01,0(R06)                Store SPACE=(???                       
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- size 1 ---                                                                
         MVC   ALCSPC1(3),DA#SIZE1       Copy First Space                       
         LA    R01,@D_SPC1               Load First Space Parm                  
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- size 2 ---                                                                
         MVC   ALCSPC2(3),DA#SIZE2       Copy Next Space                        
         LA    R01,@D_SPC2               Load Next Space Parm                   
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- dsorg ---                                                                 
         CLC   DA#DSORG,=CL2'PO'         If Not PDS File                        
         BNE   @CR_ORG1                    goto @CR_ORG1                        
* --- ( Directory Block Space ) Start ---                                       
         MVC   ALCSPCD(3),DA#SIZED       Copy Directory Space                   
         LA    R01,@D_SPCD               Load Directory Space Parm              
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- ( Directory Block Space ) End ---                                         
         MVC   ALCDSORG(2),@D_PO         Copy DSORG=PO                          
         BE    @CR_ORG2                                                         
@CR_ORG1 EQU   *                                                                
         MVC   ALCDSORG(2),@D_PS         Copy DSORG=PS                          
@CR_ORG2 EQU   *                                                                
         LA    R01,@D_DSORG              Load DSORG Address                     
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- recfm ---                                                                 
         MVC   ALCRECFM(1),DA#RECFM      Copy Recfm                             
         LA    R01,@D_RECFM              Load RECFM Address                     
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- blksize ---                                                               
         MVC   ALCBLKSZ(2),DA#BLKSZ      Copy BLKSIZE                           
         LA    R01,@D_BLKSZ              Load BLKSIZE Address                   
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- lrecl ---                                                                 
         MVC   ALCLRECL(2),DA#LRECL      Copy LRECL                             
         LA    R01,@D_LRECL              Load LRECL Address                     
         ST    R01,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Pointer                     
* --- unit ---                                                                  
         LA    R07,@D_UNIT               Load UNIT=SYSALLDA                     
         ST    R07,0(R06)                  and Store it                         
         LA    R06,4(R06)                Shift Parm Address                     
* --- dd name ---                                                               
         LA    R07,@D_RETDD              Load Return DD Name List               
         O     R07,=X'80000000'          Set End of Parm List                   
         ST    R07,0(R06)                  and Store it                         
* --- end of parameter list ---                                                 
         DROP  R11,R10                                                          
         ST    R11,RBPAREA               Load SVC 99 Parm Address               
         OI    RBPAREA,S99RBPND                                                 
         LA    R01,RBPAREA               Load SVC 99 Parm                       
         SVC   99                        Dynamic Allocate                       
         LTR   R15,R15                   If Alloc OK then                       
         BNZ   @DY_ERROR_PROC              goto @DY_OK                          
*        TPUT  =CL20'OK OK OK',20                                               
         MVC   DA#RETDD(8),ALCDD         Copy Returnd DD Name                   
         MVC   DA#RETC(4),ALLOCER        Copy Error Code                        
         XR    R15,R15                   Return Code = 0                        
         B     @BYE                      Return                                 
*-------------------------------------------------------------------            
@DY_FRE  EQU   *                                                                
         MVC   FREEDD(8),DA#RETDD        Copy Free DD Name                      
         LA    R01,FREE                  Load Free Address                      
         SVC   99                        Dynamic Alloc                          
         B     @BYE                      Return                                 
*-------------------------------------------------------------------            
@BYE     EQU   *                                                                
         L     R13,SAVEAREA+4          return                                   
         RETURN (14,12),RC=(15)                                                 
         DS    0F                                                               
*-------------------------------------------------------------------            
* --- Dynamic Allocation Error Proecss ( Get Message ) ----------------         
*-------------------------------------------------------------------            
MVDA#ERR2 MVC   2(0,R01),2(R02)           Copy Message Text                     
@DY_ERROR_PROC EQU *                                                            
         LA    R11,RBAREA                Use Request Block                      
         USING S99RB,R11                                                        
         MVC   DA#RETC(2),S99ERROR       Save Return Code                       
         MVC   DA#INFO(2),S99INFO        Save Information Code                  
         LA    R10,RBXAREA               Use Extent Request Block               
         USING S99RBX,R10                                                       
         XR    R01,R01                                                          
         IC    R01,S99ENMSG              Compute Message Result Buffer          
         SLL   R01,8                      * 256                                 
         ST    R01,ENMSGL                R01 <- Buffer Length                   
         GETMAIN RC,LV=(R01)             Getmain                                
         LTR   R15,R15                                                          
         BNZ   @DYG_ERR                  Getmain Error                          
* --- Call to Message Process -----------------------------------------         
         ST    R01,ENMSGA                Store Result Address                   
*                                                                               
         XC    EMPAREA,EMPAREA           Zero Clear EMPARMS                     
         LA    R01,EMPAREA               R01 <- EMPARMS                         
         USING EMPARMS,R01                                                      
         MVI   EMFUNCT,EMRETURN          Set Function (Message Return)          
         MVI   EMIDNUM,EMSVC99           Set ID Number                          
         MVC   EMNMSGBK(1),S99ENMSG      Message Count                          
         LA    R11,RBAREA                Set RB Area Address                    
         ST    R11,EMS99RBP                                                     
         MVC   EMRETCOD,DA#RETC          Set Dynamic Alloc Return Code          
         MVC   EMBUFP,ENMSGA             Set Result Address                     
         DROP  R01,R10,R11                                                      
         LA    R01,EMPAREAP              Set Parm Address                       
         LINK  EP=IEFDB476               Call Message Process                   
         LTR   R15,R15                   If Error                               
         BNZ   @DYL_ERR                   goto @DYL_ERR                         
* --- Result Error Message Process ------------------------------------         
         LA    R11,RBAREA                Use Request Block                      
         USING S99RB,R11                                                        
         LA    R10,RBXAREA               Use Extent Request Block               
         USING S99RBX,R10                                                       
         LA    R01,DA#ERR                Err Result Address                     
         MVC   0(1,R01),S99ENMSG         Copy Message Count                     
         LA    R01,1(R01)                Shift                                  
*                                                                               
         L     R02,ENMSGA                Error Message Address                  
         XR    R14,R14                                                          
         IC    R14,S99ENMSG              Loop Counter                           
@DY_MLOP1 EQU  *                                                                
         LH    R15,0(R02)                R15 <- Message Length                  
         STH   R15,0(R01)                 and Store It                          
*        STC   R15,*+5                                                          
*        MVC   2(0,R01),2(R02)           Copy Message Text                      
         EX    R15,MVDA#ERR2                                                    
*                                                                               
         LA    R01,2(R01,R15)            Shift Returned Message Area            
         LA    R02,256(R02)              Shift Next Message                     
         BCT   R14,@DY_MLOP1             Loop                                   
         LA    R01,DA#ERR                                                       
         DROP  R11,R10                                                          
* ---------------------------------------------------------------------         
         L     R01,ENMSGL                Freemain Message Process               
         L     R02,ENMSGA                 Work Area                             
         FREEMAIN RC,LV=(R01),A=(R02)                                           
         LA    R15,1                     Error Code = 1                         
         B     @BYE                      Return                                 
* --- Message Process Error -------------------------------------------         
@DYL_ERR EQU   *                                                                
         XC    DA#ERR(1),DA#ERR                                                 
         L     R01,ENMSGL                Freemain Message Process               
         L     R02,ENMSGA                 Work Area                             
         FREEMAIN RC,LV=(R01),A=(R02)                                           
         LA    R15,1                     Error Code = 1                         
         B     @BYE                      Return                                 
*--- Getmain Error -------------------------------------------------            
@DYG_ERR EQU   *                                                                
         XC    DA#ERR(1),DA#ERR                                                 
         LA    R15,1                     Error Code = 1                         
         B     @BYE                      Return                                 
* --- SAVE AREA ---                                                             
SAVEAREA DS    18F                               SAVEAREA                       
* --- Convert Hexa to Char Routine Work Area ---                                
         DS    0D                                                               
*--- job file control block ---                                                 
JFCB     DS    0CL176                            JOB FILE CONTROL BLOCK         
W#DSN    DS    CL44                              DATASET NAME                   
DSCB     DC    CL140' '                          DATASET CONTROL BLOCK          
W#VOL    DS    CL6                               DATASET NAME                   
ENMSGL   DS    F                                                                
ENMSGA   DS    F                                                                
         DS    0F                                                               
* --- dinamic allocations ---                                                   
ALLOC    DC    0F'0',X'80',AL3(ALLOCRB)                                         
ALLOCRB  DS    0F                                                               
         DC    AL1(20),AL1(01),AL2(0)                                           
ALLOCER  DC    AL2(0)                                                           
ALLOCIN  DC    AL2(0)                                                           
         DC    A(ALLOCTP)                                                       
         DC    A(0)                                                             
         DC    A(0)                                                             
ALLOCTP  DC    A(0)                  A(@D_DSN)                                  
         DC    A(0)                  A(@D_DISP)                                 
         DC    A(0)                  A(@D_UNIT)                                 
         DC    A(0)                  A(@D_VOL)                                  
         DC    A(0)                  X'80',AL3(@D_RETDD)                        
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
LALLOCTP EQU   *-ALLOCTP                                                        
* DDNAME <- DSN=@@@@,DISP=SHR,UNIT=SYSDA,VOL=SER=@@@@@@                         
@D_DSN   DC    XL2'0002',XL2'0001',HL2'44'                                      
ALCDSN   DS    CL44                                                             
@D_DOLD  DC    XL2'0004',XL2'0001',HL2'01',XL1'01'   disp=old                   
@D_DMOD  DC    XL2'0004',XL2'0001',HL2'01',XL1'02'   disp=mod                   
@D_DNEW  DC    XL2'0004',XL2'0001',HL2'01',XL1'04'   disp=new                   
@D_DSHR  DC    XL2'0004',XL2'0001',HL2'01',XL1'08'   disp=shr                   
@D_CTLG  DC    XL2'0005',XL2'0001',HL2'01',XL1'02'   disp=(,catlg)              
@D_UNIT  DC    XL2'0015',XL2'0001',HL2'08',CL8'SYSALLDA'                        
@D_STRK  DC    XL2'0007',XL2'0000'                                              
@D_SCYL  DC    XL2'0008',XL2'0000'                                              
@D_SBLK  DC    XL2'0009',XL2'0001',HL2'03'                                      
ALCBLK   DS    XL3                                                              
@D_SPC1  DC    XL2'000A',XL2'0001',HL2'03'                                      
ALCSPC1  DS    XL3                                                              
@D_SPC2  DC    XL2'000B',XL2'0001',HL2'03'                                      
ALCSPC2  DS    XL3                                                              
@D_SPCD  DC    XL2'000C',XL2'0001',HL2'03'                                      
ALCSPCD  DS    XL3                                                              
@D_BLKSZ DC    XL2'0030',XL2'0001',HL2'02'                                      
ALCBLKSZ DS    CL2                                                              
@D_LRECL DC    XL2'0042',XL2'0001',HL2'02'                                      
ALCLRECL DS    CL2                                                              
@D_RECFM DC    XL2'0049',XL2'0001',HL2'01'                                      
ALCRECFM DS    CL1                                                              
@D_F     DC    XL1'80'          recfm=f                                         
@D_FB    DC    XL1'90'          recfm=fb                                        
@D_DSORG DC    XL2'003C',XL2'0001',HL2'02'                                      
ALCDSORG DS    CL2                                                              
@D_PS    DC    XL2'4000'     dataset organization ( PS )                        
@D_PO    DC    XL2'0200'     dataset organization ( PS )                        
@D_VOL   DC    XL2'0010',XL2'0001',HL2'06'                                      
ALCVOL   DS    CL6                                                              
@D_RETDD DC    XL2'0055',XL2'0001',HL2'08'                                      
ALCDD    DS    CL8                                                              
@D_RETOR DC    XL2'0057',XL2'0001',HL2'02'                                      
ALCORG   DS    H                                                                
*                                                                               
@D_DDN   DC    XL2'0001',XL2'0001',HL2'08',CL8'INDD    '                        
**************************************************************                  
FREE     DC    0F'0',X'80',AL3(FREERB)                                          
FREERB   DS    0F                                                               
         DC    AL1(20),AL1(02),AL2(0)                                           
FREEER   DC    AL2(0)                                                           
FREEIN   DC    AL2(0)                                                           
         DC    A(FREETP)                                                        
         DC    A(0)                                                             
         DC    A(0)                                                             
FREETP   DC    X'80',AL3(@FREEDD)                                               
@FREEDD  DC    XL2'0001',XL2'0001',HL2'08'                                      
FREEDD   DS    CL8                                                              
DSCBFMT1 CAMLST SEARCH,W#DSN,W#VOL,DSCB                                         
         DS    0F                                                               
@D_MES01 DS    0CL83                                                            
         DC    XL01'01'                                                         
         DC    HL02'80'                                                         
         DC    CL80' This Dataset Not Found on Specified Volume Serial.*        
               '                                                                
* --- RBP -----------------------------------------------------------           
         DS    0D                                                               
RBPAREA  DS    F                                                                
* --- RB ------------------------------------------------------------           
         DS    0D                                                               
RBAREA   DS    XL64                                                             
RBLEN    EQU   (S99RBEND-S99RB)                                                 
* --- RB Text Area --------------------------------------------------           
         DS    0D                                                               
RBTEXTU  DS    XL64                                                             
* --- RBX -----------------------------------------------------------           
         DS    0D                                                               
RBXAREA  DS    XL36                                                             
* -------------------------------------------------------------------           
         DS    0D                                                               
EMPAREAP DC    A(EMPAREA)                                                       
EMPAREA  DS    XL28                                                             
         LTORG                                                                  
         COPY  RV1#ALCD                                                         
         DSECT                                                                  
         PRINT GEN                                                              
         IEFZB4D0                                                               
         DSECT                                                                  
         IEFZB476                                                               
* ---                                                                           
R00      EQU   00                                                               
R01      EQU   01                                                               
R02      EQU   02                                                               
R03      EQU   03                                                               
R04      EQU   04                                                               
R05      EQU   05                                                               
R06      EQU   06                                                               
R07      EQU   07                                                               
R08      EQU   08                                                               
R09      EQU   09                                                               
R10      EQU   10                                                               
R11      EQU   11                                                               
R12      EQU   12                                                               
R13      EQU   13                                                               
R14      EQU   14                                                               
R15      EQU   15                                                               
         END   RV1DALC                                                          
