         START                                                                  
* -----------------------------------------------------------------             
         DC   C'<< Revive ! >> ('                                               
         COPY  RV1#HDR                                                          
         PRINT   GEN                                                            
*-------------------------------------------------------------------            
* --- Start of Process --------------------------------------------             
*-------------------------------------------------------------------            
RV1EXTR  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03,R04,R05               Base Reg. R03,R04,R05                
         LA    R04,2048(R03)               2 Base Reg                           
         LA    R04,2048(R04)                                                    
         LA    R05,2048(R04)               3 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)                 
*-------------------------------------------------------------------            
*        L     R01,0(R01)                                                       
         LM    R06,R07,0(R01)              Revive Common Area                   
         USING REVIVED,R06                                                      
         USING CMDPROCD,R07                                                     
*-------------------------------------------------------------------            
*        TPUT  =CL20'??',20                                                     
         RV1#TRCC BASE=3,COMM=6                                                 
*        TPUT  =CL20'??',20                                                     
*-------------------------------------------------------------------            
*-------- ISPF VDEFINE ---------------------------------------------            
*-------------------------------------------------------------------            
@ISPVDEF EQU   *                                                                
         L     R08,RV1ISPFN              Load Var Name Pointer                  
         L     R09,RV1ISPFL              Load Var Length Pointer                
         L     R10,RV1ISPFT              load Var Type Pointer                  
         L     R11,RV1ISPFA              load Var Address Pointer               
@IS_LOP1 EQU   *                                                                
         CLC   0(8,R08),ISPVENDM         If End ?                               
         BE    @IS_LOP1X                   Goto @IS_LOP1X                       
*        TPUT  0(R08),8                                                         
         L     R01,0(R11)                Load Var Address                       
         CALL  ISPLINK,(VDEFINE,(R08),(R01),(R10),(R09)),VL                     
         LA    R08,8(R08)                Shift Var Name Pointer                 
         LA    R09,4(R09)                Shift Var Length Pointer               
         LA    R10,8(R10)                Shift Var Type Pointer                 
         LA    R11,4(R11)                Shift Var Address Pointer              
         B     @IS_LOP1                  goto Loop                              
@IS_LOP1X EQU  *                                                                
*-------------------------------------------------------------------            
*-------- Member Extract -------------------------------------------            
*-------------------------------------------------------------------            
@EXTRACT EQU   *                                                                
         XC    RV1CSPTB,RV1CSPTB                                                
*                                                                               
         L     R01,PC@RECD                                                      
         CVD   R01,PK_AREA                                                      
         MVC   EDWORK,EDMASK                                                    
         LA    R01,EDWORK+L'EDWORK-1                                            
         EDMK  EDWORK,PK_AREA                                                   
         LA    R15,EDWORK+L'EDWORK                                              
         SR    R15,R01                                                          
         LR    R00,R15                                                          
         CL    R15,=F'8'                                                        
         BH    @EXT_CALC_ERR3                                                   
         ST    R15,RV1ERECL                                                     
         LA    R01,EDWORK+L'EDWORK                                              
         SR    R01,R00                                                          
*VRV1EREC MVC   RV1EREC(0),0(R01)                                               
         EX    R15,MVRV1EREC                                                    
*                                                                               
         TM    PC@RFM,X'40'                                                     
         BO    @EXT_CALC_SKP0                                                   
         MVC   BLKSZ(2),B#BLKSZ                                                 
         MVC   VOLSER,RV1TVOL                                                   
         CALL  RV1TC,(VOLSER,BLKSZ,RV1TRKCB)                                    
         B     @EXT_CALC_SKP0X                                                  
@EXT_CALC_SKP0 EQU *                                                            
         MVC   BLKSZ(2),PC@BSZ                                                  
         MVC   VOLSER,RV1TVOL                                                   
         CALL  RV1TC,(VOLSER,BLKSZ,RV1TRKCB)                                    
@EXT_CALC_SKP0X EQU *                                                           
         LTR   R15,R15                                                          
         BNZ   @EXT_CALC_ERR1                                                   
         L     R01,RV1TRKCB                                                     
         CVD   R01,PK_AREA                                                      
         MVC   EDWORK,EDMASK                                                    
         LA    R01,EDWORK+L'EDWORK-1                                            
         EDMK  EDWORK,PK_AREA                                                   
         LA    R15,EDWORK+L'EDWORK                                              
         SR    R15,R01                                                          
         LR    R00,R15                                                          
         CL    R15,=F'8'                                                        
         BH    @EXT_CALC_ERR1                                                   
         ST    R15,RV1TRKCL                                                     
         LA    R01,EDWORK+L'EDWORK                                              
         SR    R01,R00                                                          
*VRV1TRKC MVC   RV1TRKC(0),0(R01)                                               
         EX    R15,MVRV1TRKC                                                    
         XR    R08,R08                                                          
         L     R08,PC@RECD                                                      
         SRDA  R08,32                                                           
         D     R08,RV1TRKCB                                                     
         LTR   R08,R08                                                          
         BZ    @EXT_CALC_SKP1                                                   
         LA    R09,1(R09)                                                       
@EXT_CALC_SKP1 EQU *                                                            
         ST    R09,RV1CSPTB                                                     
         CVD   R09,PK_AREA                                                      
         MVC   EDWORK,EDMASK                                                    
         LA    R01,EDWORK+L'EDWORK-1                                            
         EDMK  EDWORK,PK_AREA                                                   
         LA    R15,EDWORK+L'EDWORK                                              
         SR    R15,R01                                                          
         LR    R00,R15                                                          
         CL    R15,=F'8'                                                        
         BH    @EXT_CALC_ERR2                                                   
         ST    R15,RV1CSPTL                                                     
         LA    R01,EDWORK+L'EDWORK                                              
         SR    R01,R00                                                          
*VRV1CSPT MVC   RV1CSPT(0),0(R01)                                               
         EX    R15,MVRV1CSPT                                                    
         B     @EXT_CALC_X                                                      
@EXT_CALC_ERR3 EQU *                                                            
         MVC   RV1EREC(3),=CL3'???'                                             
         LA    R01,3                                                            
         ST    R01,RV1ERECL                                                     
@EXT_CALC_ERR1 EQU *                                                            
         MVC   RV1TRKC(3),=CL3'???'                                             
         LA    R01,3                                                            
         ST    R01,RV1TRKCL                                                     
@EXT_CALC_ERR2 EQU *                                                            
         MVC   RV1CSPT(3),=CL3'???'                                             
         LA    R01,3                                                            
         ST    R01,RV1CSPTL                                                     
@EXT_CALC_X EQU *                                                               
         CALL  ISPLINK,(VREPLACE,RV1TRKCN,RV1TRKCL,RV1TRKC),VL                  
         CALL  ISPLINK,(VREPLACE,RV1ERECN,RV1ERECL,RV1EREC),VL                  
         CALL  ISPLINK,(VREPLACE,RV1CSPTN,RV1CSPTL,RV1CSPT),VL                  
         CALL  ISPLINK,(VPUT,RV1EXTRL,PROFILE),VL  Put Space Info               
*                                                                               
         MVI   RV1EDS,C' '                                                      
         MVC   RV1EDS+1(L'RV1EDS-1),RV1EDS                                      
         MVI   RV1EDS,C''''                                                     
         MVC   RV1EDS+1(44),RV1DSNC                                             
         LA    R01,RV1EDS+1                                                     
@EXT_DSN_LOP1 EQU *                                                             
         CLI   0(R01),C' '                                                      
         BE    @EXT_DSN_LOP1X                                                   
         LA    R01,1(R01)                                                       
         B     @EXT_DSN_LOP1                                                    
@EXT_DSN_LOP1X EQU *                                                            
         LA    R02,RV1EDS_E-9                                                   
         CLR   R01,R02                                                          
         BH    @EXT_DSN_SKP1                                                    
         MVC   0(2,R01),=CL2'.M'                                                
         MVC   2(6,R01),PC@TTR                                                  
         MVI   8(R01),C''''                                                     
         B     @EXT_DSN_SKP1X                                                   
@EXT_DSN_SKP1 EQU *                                                             
         MVI   0(R01),C''''                                                     
@EXT_DSN_SKP1X EQU *                                                            
         MVC   RV1EMN,PC@NNAME                                                  
         MVC   RV1EVO,RV1TVOL                                                   
         MVC   RV1ESP,=CL3'TRK'                                                 
         MVC   RV1ESQ1,RV1CSPTB                                                 
         MVC   RV1ESQ2,=F'1'                                                    
         MVC   RV1ESPD,=F'1'                                                    
         TM    PC@RFM,X'40'              if member 'no problem' then            
         BO    @EXT_CALC_SKP3                                                   
         MVC   RV1ERF,O#RECFM                                                   
         MVC   RV1ERL,B#LRECL                                                   
         MVC   RV1EBS,B#BLKSZ                                                   
         B     @EXT_CALC_SKP3X                                                  
@EXT_CALC_SKP3 EQU *                                                            
*        TM    B#RECFM,RECFM_V                                                  
*        BO    @EXT_CALC_SKP31                                                  
         TM    PC@RFM,X'80'                                                     
         BNO   @EXT_CALC_SKP31                                                  
*        TM    B#RECFM,RECFM_F                                                  
*        BO    @EXT_CALC_SKP32                                                  
         TM    PC@RFM,X'10'                                                     
         BNO   @EXT_CALC_SKP32                                                  
* ---RECFM : U ---                                                              
         MVC   RV1ERF,=CL3'U  '          : recfm = U                            
         XC    RV1ERL,RV1ERL             : lrecl = 0                            
         MVC   RV1EBS,PC@BSZ             : blksz = dtebsz                       
         B     @EXT_CALC_SKP3X                                                  
* ---RECFM : V ---                                                              
@EXT_CALC_SKP31 EQU *                                                           
         MVC   RV1ERF,=CL3'VB '          : recfm = VB                           
         MVC   RV1ERL,PC@LRL             : lrecl = dtelrl                       
         MVC   RV1EBS,PC@BSZ             : blksz = dtebsz                       
         B     @EXT_CALC_SKP3X                                                  
* ---RECFM : F ---                                                              
@EXT_CALC_SKP32 EQU *                                                           
         MVC   RV1ERF,=CL3'FB '          : recfm = FB                           
         MVC   RV1ERL,PC@RLNG            : lrecl = dterlng                      
         MVC   RV1EBS,PC@BSZ             : blksz = dtebsz                       
         B     @EXT_CALC_SKP3X                                                  
@EXT_CALC_SKP3X EQU *                                                           
@EXT_PNL EQU   *                                                                
         CALL  ISPLINK,(ADDPOP),VL       Make Popup Panel                       
         CALL  ISPLINK,(DISPLAY,PANELEXTR),VL   information panel               
         ST    R15,PANELRC                                                      
         CALL  ISPLINK,(REMPOP),VL       Remove Popup Panel                     
         L     R15,PANELRC                                                      
         LTR   R15,R15                   If PF03 then                           
         BZ    @EXT_PNLX                                                        
*        TPUT  =CL20'RETURN',20                                                 
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
@EXT_PNLX EQU  *                                                                
*--- Extract DCB Check ---------------------------------------------            
         LA    R01,RV1ERF                                                       
         LA    R02,3                                                            
@EXT_DCBCK_LOP1 EQU *                                                           
         CLI   0(R01),C'F'                                                      
         BE    @EXT_DCBCK_F                                                     
         CLI   0(R01),C'V'                                                      
         BE    @EXT_DCBCK_V                                                     
         CLI   0(R01),C'U'                                                      
         BE    @EXT_DCBCK_U                                                     
         LA    R01,1(R01)                                                       
         BCT   R02,@EXT_DCBCK_LOP1                                              
         B     @EXT_DCBCK_WORN                                                  
@EXT_DCBCK_F EQU *                                                              
         TM    PC@RFM,X'10'                                                     
         BO    @EXT_DCBCK_WORN                                                  
         B     @EXT_DCBCK_OK                                                    
@EXT_DCBCK_V EQU *                                                              
         TM    PC@RFM,X'80'                                                     
         BO    @EXT_DCBCK_WORN                                                  
         B     @EXT_DCBCK_OK                                                    
@EXT_DCBCK_U EQU *                                                              
         B     @EXT_DCBCK_OK                                                    
@EXT_DCBCK_WORN EQU *                                                           
         CALL  ISPLINK,(ADDPOP),VL       Make Popup Panel                       
         CALL  ISPLINK,(DISPLAY,PANELEXTW),VL   information panel               
         ST    R15,PANELRC                                                      
         CALL  ISPLINK,(REMPOP),VL       Remove Popup Panel                     
         L     R15,PANELRC                                                      
         LTR   R15,R15                   If PF03 then                           
         BNZ   @EXT_PNL                                                         
@EXT_DCBCK_OK EQU *                                                             
*--- Getmain Dynamic Allocation Work Area --------------------------            
         L     R01,=A(RV1ALCDL)                                                 
         GETMAIN RC,LV=(R01)             Getmain Dynamic Alloc Work A           
         LTR   R15,R15                   If not Error                           
         BZ    @EXT_ALC                    goto @EXT_ALC                        
         BAL   R14,GETMAIN_ERROR                                                
*        LA    R15,8                                                            
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=8                                                    
@EXT_ALC EQU   *                                                                
         ST    R01,@EXT_GETMA            Save Address                           
         LR    R11,R01                                                          
         USING RV1ALCD,R11                                                      
*        MVC   DA#DSN(44),RV1EDS         Extract Dataset Name                   
         LA    R00,RV1EDS                                                       
         LA    R01,DA#DSN                                                       
         BAL   R14,@DS_CONV                                                     
         LA    R01,DA#DSN                                                       
*        TPUT  (R01),44                                                         
         MVC   DA#VOL(6),RV1EVO          Extract Volume Serial                  
         MVC   DA#DISP(3),=CL3'NEW'      Extract Discription                    
         L     R01,RV1ESPD                                                      
         LTR   R01,R01                                                          
         BZ    @EXT_DSORG_PS                                                    
         MVC   DA#DSORG(2),=CL2'PO'      Extract Dataset Organization           
         MVC   DA#SIZED(3),RV1ESPD+1     Extract Directory Size                 
         B     @EXT_DSORG_X                                                     
@EXT_DSORG_PS EQU *                                                             
         MVC   DA#DSORG(2),=CL2'PS'      Extract Dataset Organization           
@EXT_DSORG_X EQU *                                                              
         MVC   DA#SPC(3),=CL3'TRK'       Extract Units                          
         MVC   DA#SIZE1(3),RV1ESQ1+1     Extract Primary Quantity               
         MVC   DA#SIZE2(3),RV1ESQ2+1     Extract Secondary Quantity             
         MVC   DA#LRECL(2),RV1ERL        Extract Logical Record Length          
         MVC   DA#BLKSZ(2),RV1EBS        Extract Block Size                     
*        MVC   DA#RECFM(1),RV1ERF        Extract Record Format                  
         LA    R01,RV1ERF                                                       
         LA    R02,DA#RECFM                                                     
         BAL   R14,@CNVRECFM             Recfm Convert                          
*                                                                               
         DROP  R11                                                              
         L     R01,@EXT_GETMA            Set Parameter                          
         CALL  RV1DALC                   Call Dynamic Alloc Routine             
*                                                                               
         LTR   R15,R15                   if rc = 0 then                         
         BZ    @EXT_OK                     goto @DY_OK                          
*--- Dynamic Allocation Error Process ------------------------------            
         L     R11,@EXT_GETMA            Dynamic Allocation Dsect               
         USING RV1ALCD,R11                                                      
         LA    R01,DA#RETC               Return Code                            
         CALL  RV1BTH,((R01),DYRETCC,2)   Convert to Hexa Char                  
         LA    R01,DA#INFO               Information Code                       
         CALL  RV1BTH,((R01),DYINFOC,2)   Convert to Hexa Char                  
         CALL  ISPLINK,(VREPLACE,M1N,L4,DYRETCC),VL                             
         CALL  ISPLINK,(VREPLACE,M2N,L4,DYINFOC),VL                             
*                                                                               
         XR    R01,R01                                                          
         IC    R01,DA#ERR                                                       
         LTR   R01,R01                                                          
         BZ    @EXT_NOMSG                                                       
*                                                                               
         L     R01,=A(L'DA#ERR)                                                 
         GETMAIN RC,LV=(R01)            Getmain Error Message Text A            
         LTR   R15,R15                   If Error                               
         BNZ   @EXT_NOMSG                  goto @ID_NOMSG                       
         LR    R10,R01                                                          
         ST    R10,DAMSGA                                                       
*                                                                               
         XR    R01,R01                                                          
         IC    R01,DA#ERR                                                       
*                                                                               
         LA    R02,DA#ERR+1                                                     
@EXT_MLOP1 EQU  *                                                               
         LH    R15,0(R02)                                                       
*VDA#ERR2 MVC   0(0,R10),2(R02)                                                 
         EX    R15,MVDA#ERR2                                                    
         LA    R02,2(R02,R15)                                                   
         LA    R10,0(R10,R15)                                                   
         MVI   0(R10),C' '                                                      
         LA    R10,1(R10)                                                       
         BCT   R01,@EXT_MLOP1                                                   
*                                                                               
         S     R10,DAMSGA                                                       
         ST    R10,DAMSGL                                                       
         L     R01,DAMSGA                                                       
         CALL  ISPLINK,(VREPLACE,M3N,DAMSGL,(R01)),VL                           
         CALL  ISPLINK,(SETMSG,REV011),VL                                       
*                                                                               
         L     R01,@EXT_GETMA                                                   
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
         L     R01,DAMSGA                                                       
         L     R02,=A(L'DA#ERR)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
*        LA    R15,8                     Return 8                               
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=8                                                    
@EXT_NOMSG EQU  *                                                               
         CALL  ISPLINK,(SETMSG,REV012),VL                                       
*                                                                               
         L     R01,@EXT_GETMA                                                   
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
*        LA    R15,8                     Return 8                               
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=8                                                    
         DROP  R11                                                              
**********************************************                                  
@EXT_OK  EQU   *                                                                
*        MVC   WKMES,=CL80' > '                                                 
*        CALL  RV1BTH,(RV1EBS,WKMES+10,2)                                       
*        TPUT  WKMES,80                                                         
*                                                                               
         LH    R02,RV1EBS                Load BlockSize                         
         GETMAIN RC,LV=(R02)             Member TTR Save Area                   
         LTR   R15,R15                                                          
         BNZ   @EXT_GETMAIN_ERROR                                               
         ST    R01,EXTRBUFA              Store Address                          
*                                                                               
         L     R01,RV1ESPD                                                      
         LTR   R01,R01                                                          
         BZ    @EXT_COPY_PS                                                     
         B     @EXT_COPY_PO                                                     
@EXT_COPY_PS EQU *                                                              
         L     R11,@EXT_GETMA            Set Parameter                          
         USING RV1ALCD,R11                                                      
         MVC   EXTDCBPS+X'28'(8),DA#RETDD                                       
*        MVC   EXTDCBPS+X'24'(1),RV1ERF     record format                       
         LA    R01,RV1ERF                                                       
         LA    R02,EXTDCBPS+X'24'                                               
         BAL   R14,@CNVRECFM             Recfm Convert                          
         MVC   EXTDCBPS+X'3E'(2),RV1EBS     copy block size                     
         MVC   EXTDCBPS+X'52'(2),RV1ERL     copy logical record length          
*        MVC   PDSFR+X'24'(1),RV1ERF        record format                       
         LA    R01,RV1ERF                                                       
         LA    R02,PDSFR+X'24'                                                  
         BAL   R14,@CNVRECFM             Recfm Convert                          
         MVC   PDSFR+X'3E'(2),RV1EBS        copy block size                     
         MVC   PDSFR+X'52'(2),RV1ERL        copy logical record length          
         MVC   PDSFR+X'28'(8),RV1DDN     Extract Data Read DD                   
         OPEN  (PDSFR,,EXTDCBPS,(OUTPUT))                                       
         POINT PDSFR,PC@TTRB                    FIRST DATA ADDRESS              
@EXT_CPS_LOP EQU *                                                              
*        TPUT  =CL80'** WRITE **',80                                            
         L     R10,EXTRBUFA                                                     
         READ  DECB40,SF,PDSFR,(R10),'S'                                        
         CHECK DECB40                            ( FIRST BLOCK )                
         LH    R01,RV1EBS                                                       
         L     R02,DECB40+16                                                    
         SH    R01,14(R02)                                                      
         STH   R01,EXTDCBPS+X'3E'               copy block size                 
         WRITE DECB41,SF,EXTDCBPS,(R10),'S'                                     
         CHECK DECB41                            ( FIRST BLOCK )                
         B     @EXT_CPS_LOP                                                     
@EXT_CPS_LOPX EQU *                                                             
         CLOSE (PDSFR,,EXTDCBPS)                                                
         MVC   DA#DISP(3),=CL3'FRE'            free                             
         MVC   DA#RETDD(8),EXTDCBPS+X'28'                                       
         DROP  R11                                                              
         L     R01,@EXT_GETMA            Set Parameter                          
         CALL  RV1DALC                   Call Dynamic Alloc Routine             
         L     R01,EXTRBUFA                                                     
         LH    R02,RV1EBS                                                       
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
         L     R01,@EXT_GETMA                                                   
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
*                                                                               
         CALL  ISPLINK,(SETMSG,REV021),VL                                       
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
*-------------------------------------------------------------------            
@EXT_COPY_PO EQU *                                                              
*        BR    R12                                                              
         L     R11,@EXT_GETMA            Set Parameter                          
         USING RV1ALCD,R11                                                      
         MVC   EXTDCBPO+X'28'(8),DA#RETDD                                       
*        MVC   EXTDCBPO+X'24'(1),RV1ERF                                         
         LA    R01,RV1ERF                                                       
         LA    R02,EXTDCBPO+X'24'                                               
         BAL   R14,@CNVRECFM             Recfm Convert                          
         MVC   EXTDCBPO+X'3E'(2),RV1EBS     copy block size                     
         MVC   EXTDCBPO+X'52'(2),RV1ERL     copy logical record length          
*        MVC   PDSFRPO+X'24'(1),RV1ERF                                          
         LA    R01,RV1ERF                                                       
         LA    R02,PDSFRPO+X'24'                                                
         BAL   R14,@CNVRECFM             Recfm Convert                          
         MVC   PDSFRPO+X'3E'(2),RV1EBS      copy block size                     
         MVC   PDSFRPO+X'52'(2),RV1ERL      copy logical record length          
*                                                                               
*        MVC   WKMES,=CL80' > RECFM:@@@ LRECL:@@@@ BLKSZ:@@@@'                  
*        MVC   WKMES+09(3),RV1ERF                                               
*        CALL  RV1BTH,(RV1ERL,WKMES+19,2)                                       
*        CALL  RV1BTH,(RV1EBS,WKMES+30,2)                                       
*        TPUT  WKMES,80                                                         
*                                                                               
         MVC   PDSFRPO+X'28'(8),RV1DDN   Extract Data Read DD                   
         OPEN  (PDSFRPO,,EXTDCBPO,(OUTPUT))                                     
* --- DSCB type 1 ( dstaset formation )                                         
         XC    DSCB1,DSCB1               Clear Type1 DSCB Area                  
         MVC   DSCB1DSN(44),DA#DSN       Copy DSN to OBTAIN Area                
         MVC   DSCB1VOL(06),DA#VOL       Copy VOL to OBTAIN Area                
         OBTAIN DSCBFMT1                 Get Type1 DSCB                         
         LTR   R15,R15                   If not Error ?                         
         BZ    @EXT_CPO_SKP1               goto @DSCB1CK                        
         TPUT  =CL20'OBTAIN ERROR',20    *****************************          
@EXT_CPO_SKP1 EQU *                                                             
         USING DSCBSEC1,R10              DSCB1 Base Reg. R11                    
         LA    R10,JFCB1                                                        
         MVC   WRITE_TTR(4),DS1LSTAR                                            
*        CALL  RV1BTH,(WRITE_TTR,WKMES+10,4)                                    
*        CALL  RV1BTH,(PC@TTRB,WKMES+20,4)                                      
*        TPUT  WKMES,80                                                         
*                                                                               
*        MVC   WKMES,=CL80' > POINT:@@@@@@'                                     
*        CALL  RV1BTH,(WRITE_TTR,WKMES+09,3)                                    
*        TPUT  WKMES,80                                                         
*                                                                               
         POINT EXTDCBPO,WRITE_TTR        FIRST DATA ADDRESS                     
*                                                                               
         POINT PDSFRPO,PC@TTRB                    FIRST DATA ADDRESS            
@EXT_CPO_LOP EQU *                                                              
*        TPUT  =CL80'** READ  **',80                                            
         L     R10,EXTRBUFA                                                     
         READ  DECB30,SF,PDSFRPO,(R10),'S'                                      
         CHECK DECB30                            ( FIRST BLOCK )                
*        TPUT  =CL80'** WRITE **',80                                            
         LH    R01,RV1EBS                                                       
         L     R02,DECB30+16                                                    
         SH    R01,14(R02)                                                      
         STH   R01,EXTDCBPO+X'3E'               copy block size                 
*                                                                               
*        MVC   WKMES,=CL80' > WRITE LENGTH:@@@@'                                
*        CALL  RV1BTH,(EXTDCBPO+X'3E',WKMES+16,2)                               
*        TPUT  WKMES,80                                                         
*                                                                               
         WRITE DECB31,SF,EXTDCBPO,(R10),'S'                                     
         CHECK DECB31                            ( FIRST BLOCK )                
         B     @EXT_CPO_LOP                                                     
@EXT_CPO_LOPX EQU *                                                             
*        TPUT  =CL20'STOW',20                                                   
         MVC   SA_NAME(8),RV1EMN                                                
         STOW  EXTDCBPO,ST#LISTA,A                                              
         ST    R15,STOW_RC                                                      
         ST    R00,STOW_RSN                                                     
         CLOSE (PDSFRPO,,EXTDCBPO)                                              
         MVC   DA#DISP(3),=CL3'FRE'            free                             
         MVC   DA#RETDD(8),EXTDCBPO+X'28'                                       
         DROP  R11                                                              
         L     R01,@EXT_GETMA            Set Parameter                          
         CALL  RV1DALC                   Call Dynamic Alloc Routine             
         L     R01,EXTRBUFA                                                     
         LH    R02,RV1EBS                                                       
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
         L     R01,@EXT_GETMA                                                   
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
*                                                                               
         CALL  ISPLINK,(SETMSG,REV021),VL                                       
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
*        BR    R12                                                              
@EXT_GETMAIN_ERROR EQU *                                                        
         BAL   R14,GETMAIN_ERROR                                                
         L     R11,@EXT_GETMA            Set Parameter                          
         USING RV1ALCD,R11                                                      
         MVC   DA#DISP(3),=CL3'FRE'            free                             
         MVC   DA#RETDD(8),EXTDCBPO+X'28'                                       
         DROP  R11                                                              
         L     R01,@EXT_GETMA            Set Parameter                          
         CALL  RV1DALC                   Call Dynamic Alloc Routine             
         L     R01,@EXT_GETMA                                                   
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
*        BR    R12                                                              
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
@DS_CONV EQU   *                                                                
         STM   R00,R14,@DC_REGS                                                 
         LR    R10,R00                   From Address ( 46 Byte )               
         LR    R08,R01                   To Address ( 44 Byte )                 
*                                                                               
         MVI   0(R08),C' '               Space Clear                            
         MVC   1(44-1,R08),0(R08)                                               
*                                                                               
         CLI   0(R10),C''''              If Quotation                           
         BE    @DC_SKP1                    goto @DC_SKP1                        
         LA    R01,RVPREFIX              R01 <- TSO Prefix Address              
         LA    R02,7                     R02 <- Maximam Length                  
@DC_LOP1 EQU   *                                                                
         CLI   0(R01),C' '               If End ?                               
         BE    @DC_LOP1X                   goto @DC_LOP1X                       
         LA    R01,1(R01)                Shift                                  
         BCT   R02,@DC_LOP1              Loop @DC_LOP1                          
@DC_LOP1X EQU  *                                                                
         LA    R15,RVPREFIX              Calculate Prefix Length                
         SR    R01,R15                                                          
*        STC   R01,*+5                                                          
*        MVC   0(0,R08),ZPREFIX          Copy TSO Prefix                        
*VDSNP   MVC   0(0,R08),ZPREFIX          Copy TSO Prefix                        
         EX    R01,MVDSNP                                                       
         LA    R08,0(R08,R01)            R08 <- DSN Address + Prefix            
         MVI   0(R08),C'.'               Add Period                             
         LA    R08,1(R08)                Plus 1 ( for Period )                  
         LR    R01,R10                   R01 <- Input Dataset Address           
         LA    R15,46-1                  R15 <- DSN Area Length                 
@DC_LOP2 EQU   *                                                                
         CLI   0(R01),C' '               If End ?                               
         BE    @DC_LOP2X                   goto @DC_LOP2X                       
         LA    R01,1(R01)                Shift                                  
         BCT   R15,@DC_LOP2              Loop @DC_LOP2                          
@DC_LOP2X EQU  *                                                                
         LA    R01,46-1                  Calculate DSN Length                   
         SR    R01,R15                                                          
*VDSNP2  MVC   0(0,R08),0(R10)           Coopy Dataset Name                     
         EX    R01,MVDSNP2                                                      
         B     @DC_SKP2                  goto Next                              
@DC_SKP1 EQU   *                         Quotation !                            
         LA    R01,1(R10)                R01 <- DSN Address                     
         LA    R15,46-1                  R15 <- DSN Length                      
@DC_LOP3 EQU   *                                                                
         CLI   0(R01),C''''              If End ?                               
         BE    @DC_LOP3X                   goto @DC_LOP3X                       
         LA    R01,1(R01)                Shift                                  
         BCT   R15,@DC_LOP3              Loop @DC_LOP3                          
@DC_LOP3X EQU  *                                                                
         LA    R01,46-1                  Calculate DSN Length                   
         SR    R01,R15                                                          
         BCTR  R01,0                                                            
*VDSNP3  MVC   0(0,R08),1(R10)           Copy DSN                               
         EX    R01,MVDSNP3                                                      
@DC_SKP2 EQU   *                                                                
         LM    R00,R14,@DC_REGS                                                 
         BR    R14                                                              
*-------------------------------------------------------------------            
@CRREGS  DS    18F                                                              
@CNVRECFM EQU  *                                                                
* R01 <- from                                                                   
* R02 <- to                                                                     
         STM   R00,R15,@CRREGS                                                  
         LR    R10,R01                                                          
         LR    R11,R02                                                          
         LA    R12,3                                                            
*        LA    R01,RV1ERF                                                       
         LA    R02,L'RV1ERF                                                     
         XC    0(1,R11),0(11)                                                   
@CR_RECFM_LOP1 EQU *                                                            
         CLI   0(R10),C'M'                                                      
         BNE   @CR_RECFM_MX                                                     
         OI    0(R11),DA#RECFM_M                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_MX EQU *                                                              
         CLI   0(R10),C'A'                                                      
         BNE   @CR_RECFM_AX                                                     
         OI    0(R11),DA#RECFM_A                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_AX EQU *                                                              
         CLI   0(R10),C'S'                                                      
         BNE   @CR_RECFM_SX                                                     
         OI    0(R11),DA#RECFM_S                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_SX EQU *                                                              
         CLI   0(R10),C'B'                                                      
         BNE   @CR_RECFM_BX                                                     
         OI    0(R11),DA#RECFM_B                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_BX EQU *                                                              
         CLI   0(R10),C'D'                                                      
         BNE   @CR_RECFM_DX                                                     
         OI    0(R11),DA#RECFM_D                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_DX EQU *                                                              
         CLI   0(R10),C'T'                                                      
         BNE   @CR_RECFM_TX                                                     
         OI    0(R11),DA#RECFM_T                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_TX EQU *                                                              
         CLI   0(R10),C'V'                                                      
         BNE   @CR_RECFM_VX                                                     
         OI    0(R11),DA#RECFM_V                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_VX EQU *                                                              
         CLI   0(R10),C'F'                                                      
         BNE   @CR_RECFM_FX                                                     
         OI    0(R11),DA#RECFM_F                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_FX EQU *                                                              
         CLI   0(R10),C'U'                                                      
         BNE   @CR_RECFM_UX                                                     
         OI    0(R11),DA#RECFM_U                                                
         B     @CR_RECFM_LOP1N                                                  
@CR_RECFM_UX EQU *                                                              
@CR_RECFM_LOP1N EQU *                                                           
         LA    R10,1(R10)                                                       
         BCT   R12,@CR_RECFM_LOP1                                               
         LM    R00,R15,@CRREGS                                                  
         BR    R14                                                              
*-------------------------------------------------------------------            
IOERR_W  EQU   *                                                                
         SYNADAF ACSMETH=BPAM                                                   
         STM   R01,R15,REGS                                                     
         LA    R01,91(R01)                                                      
*        B     @IOERR                                                           
         MVC   ERRMSG04+23(15),0(R01)                                           
         CALL  RV1BTH,(W_TTR,ERRMSG04+16,3)                                     
         TPUT  ERRMSG04,L'ERRMSG04                                              
         B     @IOERR                                                           
IOERR_WS EQU   *                                                                
         SYNADAF ACSMETH=BSAM                                                   
         STM   R01,R15,REGS                                                     
         LA    R01,91(R01)                                                      
         MVC   ERRMSG04+23(15),0(R01)                                           
         CALL  RV1BTH,(W_TTR,ERRMSG04+16,3)                                     
         TPUT  ERRMSG04,L'ERRMSG04                                              
         B     @IOERR                                                           
@IOERR   EQU   *                                                                
         LM    R01,R15,REGS                                                     
         SYNADRLS                                                               
*        LTR   R00,R00                                                          
*        BZ    @IOERRX                                                          
*        TPUT  =CL20'SYNADRLS ERR',20                                           
*+       B     @R_EXIT                                                          
@IOERRX  EQU   *                                                                
         TPUT  =CL20'RETURN      ',20                                           
         LM    R01,R15,REGS                                                     
         PRINT GEN                                                              
         RETURN                                                                 
         PRINT NOGEN                                                            
*        B     @M_NEXT                                                          
GETMAIN_ERROR EQU *                                                             
*-------------------------------------------------------------------            
*REV010                             .ALARM = YES                                
*'Insufficienty Region Size for this Function. Please Check It. and ' +         
*'add More Virtual Storage or Close Any Applications.'                          
*-------------------------------------------------------------------            
         CALL  ISPLINK,(SETMSG,REV010),VL                                       
         BR    R14                                                              
REV010   DC   CL8'REV010'                                                       
*-------------------------------------------------------------------            
*-------- Dataset Configratin Block --------------------------------            
*-------------------------------------------------------------------            
MVRV1EREC MVC   RV1EREC(0),0(R01)                                               
MVRV1TRKC MVC   RV1TRKC(0),0(R01)                                               
MVRV1CSPT MVC   RV1CSPT(0),0(R01)                                               
MVDA#ERR2 MVC   0(0,R10),2(R02)                                                 
MVDSNP   MVC   0(0,R08),RVPREFIX         Copy TSO Prefix                        
MVDSNP2  MVC   0(0,R08),0(R10)           Coopy Dataset Name                     
MVDSNP3  MVC   0(0,R08),1(R10)           Copy DSN                               
*-------------------------------------------------------------------            
WKMES    DC    CL80'>>'                                                         
* --- Pack, Unpack Work Area ---                                                
         DS    0D                                                               
PK_AREA  DC    PL8'0'                                                           
UPK_AREA DC    CL16' '                                                          
*                                1                                              
*                    6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1                            
EDMASK   DC    XL16'40202020202020202020202020202120'                           
EDWORK   DS    XL16                                                             
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
EXTDCBPS DCB   DSORG=PS,MACRF=W,DDNAME=@@@@,                           *        
               SYNAD=IOERR_WS                                                   
EXTDCBPO DCB   DSORG=PO,MACRF=W,DDNAME=@@@@,                           *        
               SYNAD=IOERR_WS                                                   
PDSFR    DCB   DSORG=PO,MACRF=(R),DDNAME=@@@@,                         *        
               SYNAD=IOERR_WS,EODAD=@EXT_CPS_LOPX                               
PDSFRPO  DCB   DSORG=PO,MACRF=(R),DDNAME=@@@@,                         *        
               SYNAD=IOERR_WS,EODAD=@EXT_CPO_LOPX                               
*                                                                               
DSCBFMT1 CAMLST SEARCH,DSCB1DSN,DSCB1VOL,DSCB1                                  
DSCB1VOL DS    CL6                                                              
JFCB1    DS    0CL176                    job file control block                 
DSCB1DSN DS    CL44                                                             
DSCB1    DS    CL140                                                            
         DS    0F                                                               
WRITE_TTR DS   XL4                                                              
*                                                                               
         DS    0F                                                               
* --- SAVE AREA ---                                                             
SAVEAREA DS    18F                               SAVEAREA                       
@DC_REGS DS    18F                                                              
* --- Work Area ---                                                             
*K#H     DS    H                                                                
WK#F     DS    F                                                                
WK#F2    DS    F                                                                
* --- Register Save ( work ) area ---                                           
REGS     DS    18F                               WORK SAVEAREA                  
         DS    0D                                                               
EXTRBUFA DS    F                                                                
PANELEXTQ DC   CL8'REV@EXTQ'                     ISPF PANEL ( INFO )            
PANELEXTR DC   CL8'REV@EXT2'                     ISPF PANEL ( INFO )            
PANELEXTW DC   CL8'REV@EXTW'                     ISPF PANEL ( INFO )            
PANELRC  DS    F                                                                
* -----------------------------------                                           
         DS    0F                                                               
ST#LIST  DS    0CL24                                                            
S_MEMBER DC    CL8'        '                                                    
S_TTR    DC    XL3'000000'                                                      
C        DC    BL1'10000110'                                                    
*                  1.......    ARIAS                                            
*                  ...11111    USER DATA LENGTH ( HALF WORD )                   
USERDATA DC    CL12'- Revive! - '                                               
*                                                                               
         DS    0F                                                               
ST#LISTA DS    0CL42                                                            
SA_NAME  DC    CL8'DUMMY   '                                                    
SA_TTR   DC    XL3'000000'                                                      
         DC    BL1'00001111'                                                    
*                  ........    ARIAS                                            
*                  ...11111    USER DATA LENGTH ( HALF WORD )                   
SA_VVMM  DC    XL4'00000000'                                                    
SA_CRE   DC    XL4'0099049F'                                                    
SA_CHA   DC    XL4'0099049F'                                                    
SA_CHAH  DC    XL2'0000'                                                        
SA_SIZE  DC    XL2'0000'                                                        
SA_INIT  DC    XL2'0000'                                                        
SA_MOD   DC    XL2'0000'                                                        
SA_USER  DC    CL8'REVIVE!'                                                     
SA_FIL   DC    CL2'  '                                                          
*                                                                               
         DS    0F                                                               
REV011   DC    CL8'REV011'                                                      
REV012   DC    CL8'REV012'                                                      
REV021   DC    CL8'REV021'                                                      
DYRETCC  DS    CL4                                                              
DYINFOC  DS    CL4                                                              
L4       DC    F'4'                                                             
L8       DC    F'8'                                                             
DAMSGA   DS    F                                                                
DAMSGL   DS    F                                                                
* --- work of ttr ---                                                           
W_TTR    DS    0F,XL4                            work ttr                       
         DS    0F                                                               
STOW_RC  DS    F                                                                
STOW_RSN DS    F                                                                
STOW_TTR DS    XL4                                                              
STOW_NAME DS   CL8                                                              
* --- Getmain Address ---                                                       
@EXT_GETMA DS  F                                                                
         DS    0F                                                               
*--- messages ---                                                               
*                   |....+....1....+....2....+....3....+....4....+....5         
*              ....+....6....+....7....+....8                                   
ERRMSG04 DC    CL60'< I/O Error TTR:@@@@@@ @@@@@@@@@@@@@@@ >'                   
*-------------------------------------------------------------------            
RV1EXTRL DC    CL26'(RV1TRKC RV1EREC RV1CSPT)'                                  
RV1TRKC  DS    CL8                                                              
RV1EREC  DS    CL8                                                              
RV1CSPT  DS    CL8                                                              
RV1TRKCB DS    F                         Blocks per 1 Track                     
RV1TRKCN DC    CL8'RV1TRKC '                                                    
RV1TRKCL DS    F                                                                
RV1ERECB DS    F                         Member Records                         
RV1ERECN DC    CL8'RV1EREC '                                                    
RV1ERECL DS    F                                                                
RV1CSPTB DS    F                         Request Tracks                         
RV1CSPTN DC    CL8'RV1CSPT '                                                    
RV1CSPTL DS    F                                                                
M1N      DC    CL8'M1'                                                          
M2N      DC    CL8'M2'                                                          
M3N      DC    CL8'M3'                                                          
M4N      DC    CL8'M4'                                                          
M5N      DC    CL8'M5'                                                          
*-------------------------------------------------------------------            
VOLSER   DS    CL8                                                              
BLKSZ    DS    XL2                                                              
*-------------------------------------------------------------------            
         LTORG                                                                  
*-------------------------------------------------------------------            
         COPY  RV1#ISPC                                                         
         COPY  RV1#ETOP                                                         
*-------------------------------------------------------------------            
         DSECT                                                                  
         COPY RV1#COMM                                                          
*-------------------------------------------------------------------            
         RV1#CMDA SECTTYP=DSECT                                                 
*-------------------------------------------------------------------            
         DS    0D                                                               
*-------------------------------------------------------------------            
         RV1#ISPV SECTTYP=DSECT                                                 
*-------------------------------------------------------------------            
         COPY  RV1#ALCD                                                         
*-------------------------------------------------------------------            
         COPY RV1#DTH                                                           
*-------------------------------------------------------------------            
         RV1#DTE  SECTTYP=DSECT                                                 
*-------------------------------------------------------------------            
         RV1#FMTB SECTTYP=DSECT                                                 
*-------------------------------------------------------------------            
JFCBSECT DSECT                                                                  
         IEFJFCBN LIST=YES                                                      
         IEFUCBOB LIST=YES                                                      
         DCBD  DSORG=PO,DEVD=DA                                                 
         CVT   DSECT=YES,LIST=YES                                               
DSCBSEC1 DSECT                                                                  
         IECSDSL1 (1)                                                           
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   RV1EXTR                                                          
