         START                                                                  
* -----------------------------------------------------------------             
         DC   C'<< Revive ! : Get Dataset Information >>'                       
         COPY RV1#HDR                                                           
         PRINT NOGEN                                                            
* --- Start of Process --------------------------------------------             
RV1DSI   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)                   
         LR    R12,R01                   Load Dsect Address                     
         USING REVIVED,R12                                                      
*-------------------------------------------------------------------            
         RV1#TRCC BASE=3,COMM=12                                                
*-------------------------------------------------------------------            
* --- Job File Control Block ---                                                
         LA    R11,RV1JFCB               Load JFCB Address                      
         USING JFCBSECT,R11                                                     
*                                                                               
         MVC   RV1TVOL,JFCBVOLS          Volume Serial                          
         MVC   VOLUME,JFCBVOLS           Volume Serial for CAMLST               
         MVC   B#DSORG,JFCDSRG1          Dataset Organization                   
         MVC   B#RECFM,JFCRECFM          Record Format                          
*                                                                               
         MVC   O#RECFM,=CL3'?'           Set Default Char(Unknown)              
         LA    R01,O#RECFM               R01 <- RECFM Out Area                  
         TM    JFCRECFM,X'C0'            If not RECFM=U ?                       
         BNO   @JSKP11                     goto @JSKP11                         
         MVI   0(R01),C'U'               Set 'U' to RECFM Output Area           
         LA    R01,1(R01)                  and Shift                            
         B     @JSKP1X                                                          
@JSKP11  EQU   *                                                                
         TM    JFCRECFM,X'80'            If not RECFM=F ?                       
         BNO   @JSKP12                     goto @JSKP12                         
         MVI   0(R01),C'F'               Set 'F' to RECFM Output Area           
         LA    R01,1(R01)                  and Shift                            
         B     @JSKP1X                                                          
@JSKP12  EQU   *                                                                
         TM    JFCRECFM,X'40'            If not RECFM=V ?                       
         BNO   @JSKP13                     goto @JSKP13                         
         MVI   0(R01),C'V'               Set 'V' to RECFM Output Area           
         LA    R01,1(R01)                  and Shift                            
         B     @JSKP1X                                                          
@JSKP13  EQU   *                                                                
@JSKP1X  EQU   *                                                                
         TM    JFCRECFM,X'10'            If not RECFM=B ?                       
         BNO   @JSKP21                     goto @JSKP21                         
         MVI   0(R01),C'B'               Set 'B' to RECFM Output Area           
         LA    R01,1(R01)                  and Shift                            
         B     @JSKP2X                                                          
@JSKP21  EQU   *                                                                
@JSKP2X  EQU   *                                                                
         TM    JFCRECFM,X'08'            If not RECFM=S ?                       
         BNO   @JSKP31                     goto @JSKP31                         
         MVI   0(R01),C'S'               Set 'S' to RECFM Output Area           
         LA    R01,1(R01)                  and Shift                            
         B     @JSKP3X                                                          
@JSKP31  EQU   *                                                                
         TM    JFCRECFM,X'04'            If not RECFM=A ?                       
         BNO   @JSKP32                     goto @JSKP32                         
         MVI   0(R01),C'A'               Set 'A' to RECFM Output Area           
         LA    R01,1(R01)                  and Shift                            
         B     @JSKP3X                                                          
@JSKP32  EQU   *                                                                
         TM    JFCRECFM,X'02'            If not RECFM=M ?                       
         BNO   @JSKP33                     goto @JSKP33                         
         MVI   0(R01),C'M'               Set 'M' to RECFM Output Area           
         LA    R01,1(R01)                  and Shift                            
         B     @JSKP3X                                                          
@JSKP33  EQU   *                                                                
@JSKP3X  EQU   *                                                                
*                                                                               
         MVC   B#BLKSZ,JFCBLKSI          Copy Block Size                        
*        MVC   O#BLKSZ,JFCBLKSI          Copy Block Size                        
* --- records# of 1 track ---                                                   
*        TPUT  =CL10'* START *',10                                              
         LA    R02,B#BLKSZ                                                      
         CALL  RV1TC,(VOLUME,(R02),R)                                           
*        TPUT  =CL10'* END   *',10                                              
* --- Logical Record Length ---                                                 
         MVC   B#LRECL,JFCLRECL          Copy Logical Record Length             
*        MVC   O#LRECL,JFCLRECL          Copy Logical Record Length             
* --- Directory Block ---                                                       
         MVC   O#DBLK,JFCBDQTY           Directory Block                        
* --- drop jfcb dsect ---                                                       
         DROP  R11                                                              
* --- DSCB type 4 ( volume information ) ---                                    
         XC    DSCB4,DSCB4               Clear DSCB for Type4                   
         MVI   DSCB4DSN,X'04'            Move to DSCB 4 Name                    
         MVC   DSCB4DSN+1(43),DSCB4DSN                                          
         OBTAIN DSCBFMT4                 Get DSCB 4                             
         LTR   R15,R15                   If not Error ?                         
         BZ    @DSCB4CK                    goto @DSCB4CK                        
         TPUT  ERRMSG02,L'ERRMSG02       ***************************            
@DSCB4CK EQU   *                                                                
         USING DSCBSEC4,R11              DSCB4 Base Reg. R11                    
         LA    R11,DSCB4                                                        
         MVC   B#CYL#,DS4DSCYL           Copy Logical Cylindar                  
         MVC   B#TRK#,DS4DSTRK           Copy Track in a Cylindar               
         DROP  R11                                                              
* --- DSCB type 1 ( dstaset formation ) ---                                     
         XC    DSCB1,DSCB1               Clear Type1 DSCB Area                  
         LA    R01,RV1DSNC               Load Dataset Name Address              
         MVC   DSCB1DSN(44),0(R01)       Copy DSN to OBTAIN Area                
         OBTAIN DSCBFMT1                 Get Type1 DSCB                         
         LTR   R15,R15                   If not Error ?                         
         BZ    @DSCB1CK                    goto @DSCB1CK                        
         TPUT  ERRMSG03,L'ERRMSG03       *****************************          
@DSCB1CK EQU   *                                                                
         USING DSCBSEC1,R11              DSCB1 Base Reg. R11                    
         LA    R11,JFCB1                                                        
* --- last used track ---                                                       
         MVC   B#ETTR,DS1LSTAR           Copy Last Used Track                   
*                                                                               
         LA    R01,DS1LSTAR              Copy Last Used Track(Hex)              
         LA    R02,O#AUP2                                                       
         CALL  RV1BTH,((R01),(R02),3)                                           
*                                                                               
         L     R00,DS1LSTAR              R00 <- DS1LSTAR                        
         N     R00,=X'FFFFFF00'          Clear n Records ( TTRn )               
         L     R01,VPDSF                 R01 <- PDSF DCB Address                
         L     R01,44(R01)               R01 <- DEB Address                     
         N     R01,=X'00FFFFFF'          Clear IFLGS Area                       
*        LA    R01,0(R01)                                                       
         LA    R02,B#ECHR                Result Address                         
         BAL   R14,@CNVCHR               Convert TTRx -> MBBCCHHR               
         LA    R01,B#ECHR                                                       
         LA    R02,O#AUP                                                        
         CALL  RV1BTH,((R01),(R02),8)    Convert MBBCCHHR -> Hex Char           
* --- Start Address ---                                                         
*                     T T R n                                                   
         L     R00,=X'00000100'          First TTRx Address                     
         L     R01,VPDSF                 R01 <- PDSF DCB Address                
         L     R01,44(R01)               R01 <- DEB Address                     
         N     R01,=X'00FFFFFF'          Clear IFLSG Area                       
         LA    R02,W_CHR                 Result Address                         
         BAL   R14,@CNVCHR               Convert TTRx -> MBBCCHHR               
         LA    R01,O#ASP                                                        
         CALL  RV1BTH,(W_CHR,(R01),8)    Convert MBBCCHHR -> Hex Char           
* --- Extent ---                                                                
         MVC   O#EXT,DS1NOEPV            Copy Extent                            
* --- System Code ---                                                           
         MVC   O#SYSCD,DS1SYSCD          Copy System Code                       
* --- creation date ---                                                         
         XR    R01,R01                   Clear                                  
         IC    R01,DS1CREDT              R01 <- Creation Date ( YY )            
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         MVC   O#CRE(2),UPK_AREA+6                                              
         MVI   O#CRE+2,C'/'                                                     
         L     R01,DS1CREDT              R01 <- Creation Date ( DDD )           
         SRL   R01,8                                                            
         N     R01,=X'0000FFFF'                                                 
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         MVC   O#CRE+3(3),UPK_AREA+5                                            
* --- Expiration Date ---                                                       
         IC    R01,DS1EXPDT              R01 <- Expiration Date ( YY) )         
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         MVC   O#EXP(2),UPK_AREA+6                                              
         MVI   O#EXP+2,C'/'                                                     
         L     R01,DS1EXPDT              R01 <- Expiration Date ( DDD )         
         SRL   R01,8                                                            
         CL    R01,=F'0'                                                        
         BE    @EXPJP1                                                          
         N     R01,=X'0000FFFF'                                                 
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         MVC   O#EXP+(3),UPK_AREA+5                                             
         B     @EXPJP2                                                          
MVB#EXTENT MVC   B#EXTENT+1(0),B#EXTENT                                         
MVO#EXTENT MVC   O#EXTENT+1(0),O#EXTENT                                         
@EXPJP1  EQU   *                                                                
         MVC   O#EXP,=CL6'*NONE*'                                               
@EXPJP2  EQU   *                                                                
* --- extent address ---                                                        
         MVI   B#EXTENT,X'00'            Extent Area Zero Clear                 
         LA    R01,B#EXTENTL                                                    
         BCTR  R01,0                                                            
         BCTR  R01,0                                                            
*        STC   R01,*+5                                                          
*        MVC   B#EXTENT+1(0),B#EXTENT                                           
         EX    R01,MVB#EXTENT                                                   
         MVI   O#EXTENT,C' '             Extent Area Space Clear                
         LA    R01,O#EXTENTL                                                    
         BCTR  R01,0                                                            
         BCTR  R01,0                                                            
*        STC   R01,*+5                                                          
*        MVC   O#EXTENT+1(0),O#EXTENT                                           
         EX    R01,MVO#EXTENT                                                   
*                                                                               
         XR    R06,R06                   R06 <- Extent Number                   
         IC    R06,DS1NOEPV                                                     
         MVC   B#TCHR(3),=XL3'000000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+7(1),R+3        Set Last Alloc Address ( R )              
* --- extent 1 address ---                                                      
         MVC   B#L1,DS1EXT1+2            Extent #1 Low                          
         LA    R01,B#L1                                                         
         LA    R02,O#L1                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H1,DS1EXT1+6            Extent #1 High                         
         LA    R01,B#H1                                                         
         LA    R02,O#H1                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'000000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS1EXT1+6     Set End of Alloc Address               
         LA    R01,B#L1                                                         
         LA    R02,B#H1                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 2 address ---                                                      
         MVC   B#L2,DS1EXT2+2            Extent #2 Low                          
         LA    R01,B#L2                                                         
         LA    R02,O#L2                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H2,DS1EXT2+6            Extent #2 High                         
         LA    R01,B#H2                                                         
         LA    R02,O#H2                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'010000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS1EXT2+6     Set End of Alloc Address               
         LA    R01,B#L2                                                         
         LA    R02,B#H2                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 3 address ---                                                      
         MVC   B#L3,DS1EXT3+2            Extent #3 Low                          
         LA    R01,B#L3                                                         
         LA    R02,O#L3                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H3,DS1EXT3+6            Extent #3 High                         
         LA    R01,B#H3                                                         
         LA    R02,O#H3                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'020000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS1EXT3+6     Set End of Alloc Address               
         LA    R01,B#L3                                                         
         LA    R02,B#H3                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- DSCB Type 3 ( Extent Dataset Information ) ---                            
         MVC   DSCB3CHR(5),DS1PTRDS                                             
         XC    DSCB3,DSCB3                                                      
         OBTAIN DSCBFMT3                                                        
         LTR   R15,R15                                                          
         BNZ   @E_A_X                                                           
         USING DSCBSEC3,R11                                                     
         LA    R11,DSCB3                                                        
* --- extent 4 address ---                                                      
         MVC   B#L4,DS3EXTNT+2           Extent #4 Low                          
         LA    R01,B#L4                                                         
         LA    R02,O#L4                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H4,DS3EXTNT+6           Extent #4 High                         
         LA    R01,B#H4                                                         
         LA    R02,O#H4                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'030000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3EXTNT+6    Set End of Alloc Address               
         LA    R01,B#L4                                                         
         LA    R02,B#H4                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 5 address ---                                                      
         MVC   B#L5,DS3EXTNT+12          Extent #5 Low                          
         LA    R01,B#L5                                                         
         LA    R02,O#L5                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H5,DS3EXTNT+16          Extent #5 High                         
         LA    R01,B#H5                                                         
         LA    R02,O#H5                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'040000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3EXTNT+16   Set End of Alloc Address               
         LA    R01,B#L5                                                         
         LA    R02,B#H5                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 6 address ---                                                      
         MVC   B#L6,DS3EXTNT+22          Extent #6 Low                          
         LA    R01,B#L6                                                         
         LA    R02,O#L6                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H6,DS3EXTNT+26          Extent #6 High                         
         LA    R01,B#H6                                                         
         LA    R02,O#H6                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'050000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3EXTNT+26   Set End of Alloc Address               
         LA    R01,B#L6                                                         
         LA    R02,B#H6                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 7 address ---                                                      
         MVC   B#L7,DS3EXTNT+32          Extent #7 Low                          
         LA    R01,B#L7                                                         
         LA    R02,O#L7                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H7,DS3EXTNT+36          Extent #7 High                         
         LA    R01,B#H7                                                         
         LA    R02,O#H7                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'060000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3EXTNT+36   Set End of Alloc Address               
         LA    R01,B#L7                                                         
         LA    R02,B#H7                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 8 address ---                                                      
         MVC   B#L8,DS3ADEXT+2           Extent #8 Low                          
         LA    R01,B#L8                                                         
         LA    R02,O#L8                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H8,DS3ADEXT+6           Extent #8 High                         
         LA    R01,B#H8                                                         
         LA    R02,O#H8                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'070000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+6    Set End of Alloc Address               
         LA    R01,B#L8                                                         
         LA    R02,B#H8                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 9 address ---                                                      
         MVC   B#L9,DS3ADEXT+12          Extent #9 Low                          
         LA    R01,B#L9                                                         
         LA    R02,O#L9                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H9,DS3ADEXT+16          Extent #9 High                         
         LA    R01,B#H9                                                         
         LA    R02,O#H9                                                         
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'080000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+16   Set End of Alloc Address               
         LA    R01,B#L9                                                         
         LA    R02,B#H9                                                         
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 10 address ---                                                     
         MVC   B#L10,DS3ADEXT+22          Extent #10 Low                        
         LA    R01,B#L10                                                        
         LA    R02,O#L10                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H10,DS3ADEXT+26         Extent #10 High                        
         LA    R01,B#H10                                                        
         LA    R02,O#H10                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'090000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+26   Set End of Alloc Address               
         LA    R01,B#L10                                                        
         LA    R02,B#H10                                                        
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 11 address ---                                                     
         MVC   B#L11,DS3ADEXT+32         Extent #11 Low                         
         LA    R01,B#L11                                                        
         LA    R02,O#L11                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H11,DS3ADEXT+36         Extent #11 High                        
         LA    R01,B#H11                                                        
         LA    R02,O#H11                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'0A0000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+36   Set End of Alloc Address               
         LA    R01,B#L11                                                        
         LA    R02,B#H11                                                        
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 12 address ---                                                     
         MVC   B#L12,DS3ADEXT+42         Extent #12 Low                         
         LA    R01,B#L12                                                        
         LA    R02,O#L12                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H12,DS3ADEXT+46         Extent #12 High                        
         LA    R01,B#H12                                                        
         LA    R02,O#H12                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'0B0000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+46   Set End of Alloc Address               
         LA    R01,B#L12                                                        
         LA    R02,B#H12                                                        
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 13 address ---                                                     
         MVC   B#L13,DS3ADEXT+52         Extent #13 Low                         
         LA    R01,B#L13                                                        
         LA    R02,O#L13                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H13,DS3ADEXT+56         Extent #13 High                        
         LA    R01,B#H13                                                        
         LA    R02,O#H13                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'0C0000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+56   Set End of Alloc Address               
         LA    R01,B#L13                                                        
         LA    R02,B#H13                                                        
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 14 address ---                                                     
         MVC   B#L14,DS3ADEXT+62         Extent #14 Low                         
         LA    R01,B#L14                                                        
         LA    R02,O#L14                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H14,DS3ADEXT+66         Extent #14 High                        
         LA    R01,B#H14                                                        
         LA    R02,O#H14                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'0D0000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+66   Set End of Alloc Address               
         LA    R01,B#L14                                                        
         LA    R02,B#H14                                                        
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 15 address ---                                                     
         MVC   B#L15,DS3ADEXT+72         Extent #15 Low                         
         LA    R01,B#L15                                                        
         LA    R02,O#L15                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H15,DS3ADEXT+76         Extent #15 High                        
         LA    R01,B#H15                                                        
         LA    R02,O#H15                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'0E0000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+76   Set End of Alloc Address               
         LA    R01,B#L15                                                        
         LA    R02,B#H15                                                        
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
* --- extent 16 address ---                                                     
         MVC   B#L16,DS3ADEXT+82         Extent #16 Low                         
         LA    R01,B#L16                                                        
         LA    R02,O#L16                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#H16,DS3ADEXT+86         Extent #16 High                        
         LA    R01,B#H16                                                        
         LA    R02,O#H16                                                        
         CALL  RV1BTH,((R01),(R02),4)                                           
         MVC   B#TCHR(3),=XL3'0F0000'    Set Last Alloc Address ( MBB )         
         MVC   B#TCHR+3(4),DS3ADEXT+86   Set End of Alloc Address               
         LA    R01,B#L16                                                        
         LA    R02,B#H16                                                        
         BAL   R14,@E_A_TRK              Calculate Allocation Tracks            
         L     R02,O#ALC                 Allocated Track Calc Area              
         LA    R01,0(R01,R02)                                                   
         ST    R01,O#ALC                 Store Result                           
         BCTR  R06,0                     Extent -1                              
         LTR   R06,R06                   If End ?                               
         BZ    @E_A_X                      goto @E_A_X                          
**                                                                              
@E_A_X   EQU   *                                                                
         LA    R01,B#TCHR                                                       
         LA    R02,O#AEP                                                        
         CALL  RV1BTH,((R01),(R02),8)                                           
         L     R01,VPDSF                 R01 <- PDSF DCB Address                
         L     R01,44(R01)               R01 <- DEB Address                     
         N     R01,=X'00FFFFFF'          Clear IFLGS Area                       
         LA    R02,B#TCHR                                                       
         BAL   R14,@CNVTTR               convert ttr -> mbbcchhr                
         ST    R00,B#TTTR                                                       
         LA    R01,B#TTTR                                                       
         LA    R02,O#AEP2                                                       
         CALL  RV1BTH,((R01),(R02),3)                                           
*                                                                               
         L     R06,B#ETTR                                                       
         SRL   R06,16                                                           
         MH    R06,=H'100'                                                      
         L     R01,B#TTTR                                                       
         SRL   R01,16                                                           
         SRDA  R06,32                                                           
         DR    R06,R01                                                          
         STH   R07,O#USE                                                        
         DROP  R11                                                              
* --- end of sub routine ---                                                    
         RV1#TRCR COMM=12                                                       
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
@E_A_TRK EQU   *                                                                
         STM   R03,R00,REGS                                                     
         XR    R06,R06                                                          
         LH    R06,0(R02)                                                       
         SH    R06,0(R01)                                                       
         MH    R06,B#TRK#                                                       
         AH    R06,2(R02)                                                       
         SH    R06,2(R01)                                                       
         LA    R01,1(R06)                                                       
         LM    R03,R00,REGS                                                     
         BR    R14                                                              
*-------------------------------------------------------------------            
*-------- convert mbcchhr to ttr -----------------------------------            
*-------------------------------------------------------------------            
@CNVTTR  EQU   *                                                                
         STM   R03,R15,REGS                                                     
         L     R14,CVTPTR                                                       
         USING CVTMAP,R14                                                       
         L     R15,CVTPRLTV                                                     
         DROP  R14                                                              
         BALR  R14,R15                                                          
         LM    R03,R15,REGS                                                     
         BR    R14                                                              
@CNVCHR  EQU   *                                                                
         STM   R03,R15,REGS                                                     
         L     R14,CVTPTR                                                       
         USING CVTMAP,R14                                                       
         L     R15,CVTPCNVT                                                     
         DROP  R14                                                              
         BALR  R14,R15                                                          
         LM    R03,R15,REGS                                                     
         BR    R14                                                              
*                                                                               
         DS    0F                                                               
* --- SAVE AREA ---                                                             
SAVEAREA DS    18F                     savearea                                 
REGS     DS    18F                               WORK SAVEAREA                  
W_CHR    DS    0F,XL8                                                           
* --- Error Message ---                                                         
ERRMSG02 DC    CL79'*** OBTAIN Error ( DSCB - Type 4 ) ***'                     
ERRMSG03 DC    CL79'*** OBTAIN Error ( DSCB - Type 1 ) ***'                     
         DS    0D                                                               
* --- Panel RC Packed Area ---                                                  
PK_AREA  DC    PL8'0'                                                           
UPK_AREA DC    CL16' '                                                          
         DS    0F                                                               
WK#F     DS    F                                                                
         DS    0F                                                               
* --- dscb search ---                                                           
DSCBFMT1 CAMLST SEARCH,DSCB1DSN,VOLUME,DSCB1                                    
DSCBFMT3 CAMLST SEEK,DSCB3CHR,VOLUME,DSCB3                                      
DSCBFMT4 CAMLST SEARCH,DSCB4DSN,VOLUME,DSCB4                                    
VOLUME   DS    CL6                                                              
R        DS    F                                                                
DSCB3CHR DS    CL6                                                              
JFCB1    DS    0CL176                      job file control block               
DSCB1DSN DS    CL44                                                             
DSCB1    DS    CL140                                                            
DSCB3    DS    CL140                                                            
*                                                                               
JFCB4    DS    0CL176                      job file control block               
DSCB4DSN DS    CL44                        dataset name                         
DSCB4    DS    CL140                       dataset control block                
*                                                                               
VPDSF    DC    V(PDSFD)                                                         
         DS    0F                                                               
*SN      DS    CL44                                                             
         LTORG                                                                  
* --------------------------------------------------------------------          
         DSECT                                                                  
         COPY  RV1#COMM                                                         
* --------------------------------------------------------------------          
JFCBSECT DSECT                                                                  
         PRINT GEN                                                              
         IEFJFCBN LIST=YES                                                      
DSCBSEC1 DSECT                                                                  
         IECSDSL1 (1)                                                           
DSCBSEC3 DSECT                                                                  
         IECSDSL1 (3)                                                           
DSCBSEC4 DSECT                                                                  
         IECSDSL1 (4)                                                           
         IEFUCBOB LIST=YES                                                      
         DCBD  DSORG=PO,DEVD=DA                                                 
         CVT   DSECT=YES,LIST=YES                                               
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   RV1DSI                                                           
