         START                                                                  
* -----------------------------------------------------------------             
         DC   C'<< Revive ! >> ('                                               
         COPY  RV1#HDR                                                          
         PRINT NOGEN                                                            
*-------------------------------------------------------------------            
* --- Start of Process --------------------------------------------             
*-------------------------------------------------------------------            
@RV#090  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03,R04,R05,R06           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)                                                    
         LA    R06,2048(R05)               4 Base Reg                           
         LA    R06,2048(R06)                                                    
         ST    R13,SAVEAREA+4              Save A(OLD SaveArea)                 
         LR    R12,R13                                                          
         LA    R13,SAVEAREA                                                     
         ST    R13,8(R12)                  Save A(NEW SaveArea)                 
*-------------------------------------------------------------------            
*-------- Main Process ---------------------------------------------            
*-------------------------------------------------------------------            
         BAL   R12,@INITIAL                call Initial Routine                 
         BAL   R12,@ISPVDEF                call ISPF VDEFINE                    
         BAL   R12,@PQUERY                 call Query List Panel                
         LTR   R15,R15                     if Error                             
         BNZ   @BYE                          Bye !                              
@SE      EQU   *                                                                
         BAL   R12,@SHOWENT                call Entry Panel Show                
         CLC   SHOWRC,=F'0'                                                     
         BNE   @BYE                                                             
*        B     @SE                                                              
         BAL   R12,@IDSALOC                call Input Dataset Alloc             
         LTR   R15,R15                     if Allocation Error                  
         BNZ   @SE                           goto @SE                           
         BAL   R12,@GETDSI                 call Get Dataset Information         
         LTR   R15,R15                                                          
         BNZ   @SE_CLOSE                                                        
*-------------------------------------------------------------------            
         MVC   RV1PRC,=CL3'DIR'                                                 
         MVI   RV1EXTC,X'01'                                                    
         BAL   R12,@POPSCR                 Popup Panel Show                     
*-------------------------------------------------------------------            
         BAL   R12,@READD                  call Directory Read Section          
         LTR   R15,R15                                                          
         BNZ   @SE_CLOSE                                                        
         CLOSE (PDSFD)                                                          
*-------------------------------------------------------------------            
         MVC   RV1PRC,=CL3'USE'                                                 
         MVI   RV1EXTC,X'01'                                                    
         BAL   R12,@POPSCR                 Popup Panel Show                     
*-------------------------------------------------------------------            
*        BAL   R12,@READDA                 call Data Area Read Section          
*        LTR   R15,R15                                                          
*        BNZ   @SE_CLOSE                                                        
         LA    R01,REVIVED               r01 <- Dsect Address                   
         CALL  RV1DARD                                                          
         LTR   R15,R15                                                          
         BZ    @SE_READDA_SKP1                                                  
         CL    R15,=F'1'                                                        
         BNE   @SE_READDA_SKP0                                                  
         BAL   R14,GETMAIN_ERROR                                                
         B     @SE_FREE                                                         
@SE_READDA_SKP0 EQU *                                                           
         TPUT  =CL20'I/O ERR',20                                                
         B     @SE_FREE                                                         
@SE_READDA_SKP1 EQU *                                                           
*        TPUT  =CL20'*RETURN*',20                                               
         L     R15,DTLASTE                                                      
         LTR   R15,R15                                                          
         BNZ   @SE_READDA_SKP2                                                  
         CALL  ISPLINK,(SETMSG,REV018),VL                                       
         B     @SE_FREE                                                         
@SE_READDA_SKP2 EQU *                                                           
*-------------------------------------------------------------------            
         L     R01,RV1TBSPL                Directory Table                      
         L     R02,RV1TBSPA                                                     
         FREEMAIN RC,LV=(R01),A=(R02)      Dynamic Alloc Work Area              
*-------------------------------------------------------------------            
@SE_DISPLAY EQU *                                                               
         BAL   R12,PDISPLAY                                                     
         CLC   DISPLAYRC,=F'8'                                                  
         BE    @SE_DISPLAYX                                                     
         CLC   DISPLAYRC,=F'16'                                                 
         BE    @SE_DISPLAYX                                                     
*-------------------------------------------------------------------            
         BAL   R12,PCMDPROC                                                     
         LTR   R15,R15                                                          
         BNZ   @SE_DISPLAY                                                      
*-------------------------------------------------------------------            
         BAL   R12,PSCROLL                                                      
*-------------------------------------------------------------------            
         B     @SE_DISPLAY                                                      
@SE_DISPLAYX EQU *                                                              
         BAL   R12,@IDSFREE                call Dataset Free                    
         BAL   R12,TBLFREE                                                      
         B     @SE                                                              
*-------------------------------------------------------------------            
@SE_CLOSE EQU   *                                                               
         CLOSE (PDSFD)                                                          
@SE_FREE EQU   *                                                                
         BAL   R12,@IDSFREE                call Input Dataset Alloc             
         B     @SE                                                              
@BYE     EQU   *                                                                
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
*-------------------------------------------------------------------            
*-------- Initialization -------------------------------------------            
*-------------------------------------------------------------------            
@INITIAL EQU   *                                                                
         L     R01,0(R01)                Load Parm Area                         
         LH    R02,0(R01)                Load Parm Length                       
         LTR   R02,R02                   If Length is Zero ?                    
         BZ    @I_SKP1                    goto @I_SKP1                          
         CH    R02,=H'44'                If Legth > 44 ?                        
         BH    @I_SKP1                    goto @I_SKP1                          
         MVI   RV1DSN,C' '               DSN Area Space Clear                   
         MVC   RV1DSN+1(L'RV1DSN-1),RV1DSN                                      
         BCTR  R02,0                                                            
         STC   R02,*+5                                                          
         MVC   RV1DSN(0),2(R01)          Copy Arg to RV1DSN Area                
@I_SKP1  EQU   *                                                                
         LA    R01,PDSFD                 Save PDSF DCB Address                  
         ST    R01,A#PDSF                 ( PDS Data )                          
*                                                                               
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------- Popup Screen ---------------------------------------------            
*-------------------------------------------------------------------            
@POPSCR  EQU   *                                                                
         CALL  ISPLINK,(CONTROL,DISPLAY,LOCK),VL Panel Lock                     
         CALL  ISPLINK,(ADDPOP),VL       Make Popup Panel                       
         CALL  ISPLINK,(DISPLAY,PANELANL),VL Analysis Panel Show                
         CALL  ISPLINK,(REMPOP),VL       Remove Popup Panel                     
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------- ISPF VDEFINE ---------------------------------------------            
*-------------------------------------------------------------------            
@ISPVDEF EQU   *                                                                
         L     R07,RV1ISPFN              Load Var Name Pointer                  
         L     R08,RV1ISPFL              Load Var Length Pointer                
         L     R09,RV1ISPFT              load Var Type Pointer                  
         L     R10,RV1ISPFA              load Var Address Pointer               
@IS_LOP1 EQU   *                                                                
         CLC   0(8,R07),ISPVENDM         If End ?                               
         BE    @IS_LOP1X                   Goto @IS_LOP1X                       
*        TPUT  0(R07),8                                                         
         L     R01,0(R10)                Load Var Address                       
         CALL  ISPLINK,(VDEFINE,(R07),(R01),(R09),(R08)),VL                     
         LA    R07,8(R07)                Shift Var Name Pointer                 
         LA    R08,4(R08)                Shift Var Length Pointer               
         LA    R09,8(R09)                Shift Var Type Pointer                 
         LA    R10,4(R10)                Shift Var Address Pointer              
         B     @IS_LOP1                  goto Loop                              
@IS_LOP1X EQU  *                                                                
         BR    R12                       Return                                 
*-------------------------------------------------------------------            
*-------- List Panel Query -----------------------------------------            
*-------------------------------------------------------------------            
         DS    0F                                                               
@PQUERY  EQU   *                                                                
         CALL  ISPLINK,(PQUERY,PANELLST,RV1DAREAN,,VWIDTHN,VDEPTHN),VL          
         LTR   R15,R15                                                          
         BZ    @PQ_SKP2                                                         
         CALL  ISPLINK,(SETMSG,REV013),VL                                       
*REV013                             .ALARM = YES                                
*'Revive List Panel Query Error. Why? '                               +         
*'Perhaps Misstake Installation. Please Re-Install'                             
@PQ_SKP2 EQU   *                                                                
         L     R01,VDEPTH                                                       
*        BCTR  R01,0                                                            
         MH    R01,VWIDTH+2                                                     
         ST    R01,RV1DAREAL                                                    
         GETMAIN RC,LV=(R01)            Getmain Dynamic Alloc Work A            
         LTR   R15,R15                   If not Error                           
         BZ    @PQ_SKP21                   goto @PQ_SKP21                       
*--- Getmain Error -------------------------------------------------            
         BAL   R14,GETMAIN_ERROR                                                
         LA    R15,8                                                            
         BR    R12                                                              
*--- Normal Compleate ----------------------------------------------            
@PQ_SKP21 EQU   *                                                               
         ST    R01,RV1DAREAA            Store List Panel Area                   
         CALL  ISPLINK,(VDEFINE,RV1DAREAN,(R01),RV1DAREAT,RV1DAREAL),VL         
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------- Show Entry Panel -----------------------------------------            
*-------------------------------------------------------------------            
         DS    0F                                                               
@SHOWENT EQU   *                                                                
         CALL  ISPLINK,(VGET,RV1ENTRYL,PROFILE),VL  Get TSO Prefix              
         CALL  ISPLINK,(DISPLAY,PANELENT),VL  Entry Panel Show                  
         ST    R15,SHOWRC                Save Return Code                       
         MVI   RV1DSNC,C' '              Space Clear                            
         MVC   RV1DSNC+1(L'RV1DSNC-1),RV1DSNC                                   
         CALL  ISPLINK,(VPUT,RV1ENTRYL,PROFILE),VL  Get TSO Prefix              
*                                                                               
         LA    R00,RV1DSN                                                       
         LA    R01,RV1DSNC                                                      
         BAL   R14,@DS_CONV                                                     
*                                                                               
         MVI   RV1SSTRR,C' '                                                    
         MVC   RV1SSTRR+1(L'RV1SSTRR-1),RV1SSTRR                                
*                                                                               
         LA    R01,RV1SSTR                                                      
         LA    R02,L'RV1SSTR                                                    
@SEC_SSTR1 EQU *                                                                
         CLI   0(R01),C' '                                                      
         BNE   @SEC_SSTR1X                                                      
         LA    R01,1(R01)                                                       
         BCT   R02,@SEC_SSTR1                                                   
         B     @SEC_SSTRXE                                                      
@SEC_SSTR1X EQU *                                                               
         LR    R15,R01                                                          
         LA    R01,RV1SSTR+L'RV1SSTR                                            
         BCTR  R01,0                                                            
@SEC_SSTR2 EQU *                                                                
         CLI   0(R01),C' '                                                      
         BNE   @SEC_SSTR2X                                                      
         BCTR  R01,0                                                            
         BCT   R02,@SEC_SSTR2                                                   
         B     @SEC_SSTRXE                                                      
@SEC_SSTR2X EQU *                                                               
         CLI   0(R15),C''''                                                     
         BNE   @SEC_SSTR3                                                       
         LA    R15,1(R15)                                                       
         BCTR  R02,0                                                            
         CL    R02,=F'1'                                                        
         BNH   @SEC_SSTRXE                                                      
         CLI   0(R01),C''''                                                     
         BNE   @SEC_SSTR3                                                       
         BCTR  R01,0                                                            
         BCTR  R02,0                                                            
         CL    R02,=F'0'                                                        
         BNH   @SEC_SSTRXE                                                      
@SEC_SSTR3 EQU *                                                                
         STH   R02,RV1SSTRL                                                     
         BCTR  R02,0                                                            
         STC   R02,*+5                                                          
         MVC   RV1SSTRR(0),0(R15)                                               
         B     @SEC_SSTRXX                                                      
*                                                                               
@SEC_SSTRXE EQU *                                                               
         XC    RV1SSTRL,RV1SSTRL                                                
@SEC_SSTRXX EQU *                                                               
         BR    R12                       Return                                 
*-------------------------------------------------------------------            
*-------- Input Dataset Allocate -----------------------------------            
*-------------------------------------------------------------------            
@IDSALOC 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    @ID_SKP0                    goto @ID_SKP0                        
         BAL   R14,GETMAIN_ERROR                                                
         LA    R15,8                                                            
         BR    R12                                                              
@ID_SKP0 EQU   *                                                                
         ST    R01,@ID_GETMA             Save Address                           
         LR    R11,R01                                                          
*--- Space Clear Dynamic Allocation Work Area ----------------------            
         L     R02,=A(RV1ALCDL)                                                 
@ID_CLR1 EQU   *                                                                
         CL    R02,=F'256'                                                      
         BNH   @ID_CLR1X                                                        
         XC    0(256,R01),0(R01)         Null Clear                             
         LA    R01,256(R01)                                                     
         S     R02,=F'256'                                                      
         B     @ID_CLR1                                                         
@ID_CLR1X EQU  *                                                                
         STC   R02,*+5                                                          
         XC    0(0,R01),0(R01)           Null Clear                             
*--- Setup Dynamic Allocation --------------------------------------            
         USING RV1ALCD,R11                                                      
         CLI   RV1DISP,C'O'              If Not Exclusive Enq                   
         BNE   @ID_SKP1                                                         
         MVC   DA#DISP(3),=CL3'OLD'                                             
         B     @ID_SKP2                                                         
@ID_SKP1 EQU   *                         Share Enq                              
         MVC   DA#DISP(3),=CL3'SHR'                                             
@ID_SKP2 EQU   *                                                                
         MVC   DA#DSN(44),RV1DSNC        Copy Dataset Name                      
         MVC   DA#VOL(6),RV1VOL          Copy Volume Serial                     
         DROP  R11                                                              
*--- Call Dynamic Allocation ---------------------------------------            
         L     R01,@ID_GETMA             Set Parameter                          
         CALL  RV1DALC                   Call Dynamic Alloc Routine             
*                                                                               
         LTR   R15,R15                   if Allocated                           
         BZ    @ID_SKP3                    goto @ID_SKP3                        
*--- Dynamic Allocation Error Process ------------------------------            
         L     R11,@ID_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    @ID_NOMSG                                                        
*                                                                               
         L     R01,=A(L'DA#ERR)                                                 
         GETMAIN RC,LV=(R01)            Getmain Error Message Text A            
         LTR   R15,R15                   If Error                               
         BNZ   @ID_NOMSG                   goto @ID_NOMSG                       
         LR    R10,R01                                                          
         ST    R10,DAMSGA                                                       
*                                                                               
         XR    R01,R01                                                          
         IC    R01,DA#ERR                                                       
*                                                                               
         LA    R02,DA#ERR+1                                                     
@ID_MLOP1 EQU  *                                                                
         LH    R15,0(R02)                                                       
         STC   R15,*+5                                                          
         MVC   0(0,R10),2(R02)                                                  
*                                                                               
         LA    R02,2(R02,R15)                                                   
         LA    R10,0(R10,R15)                                                   
         MVI   0(R10),C' '                                                      
         LA    R10,1(R10)                                                       
         BCT   R01,@ID_MLOP1                                                    
*                                                                               
         S     R10,DAMSGA                                                       
         ST    R10,DAMSGL                                                       
         L     R01,DAMSGA                                                       
         CALL  ISPLINK,(VREPLACE,M3N,DAMSGL,(R01)),VL                           
         CALL  ISPLINK,(SETMSG,REV011),VL                                       
*                                                                               
         L     R01,@ID_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                               
         BR    R12                                                              
@ID_NOMSG EQU  *                                                                
         CALL  ISPLINK,(SETMSG,REV012),VL                                       
*                                                                               
         L     R01,@ID_GETMA                                                    
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
         LA    R15,8                     Return 8                               
         BR    R12                                                              
         DROP  R11                                                              
*--- Dunamic Allocation Normal Process -----------------------------            
@ID_SKP3 EQU   *                                                                
         L     R11,@ID_GETMA             Load Address                           
         USING RV1ALCD,R11                                                      
         MVC   RV1DDN,DA#RETDD           Save Input DD                          
         DROP  R11                                                              
*                                                                               
         L     R01,@ID_GETMA                                                    
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Dynamic Alloc Work Area                
         XR    R15,R15                   Return 0                               
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------- Input Dataset Free ---------------------------------------            
*-------------------------------------------------------------------            
@IDSFREE EQU   *                                                                
         L     R01,=A(RV1ALCDL)                                                 
         GETMAIN RC,LV=(R01)            Getmain Dynamic Alloc Work A            
         LTR   R15,R15                   If not Error                           
         BZ    @IDS_SKP1                   goto @IDS_SKP1                       
         BAL   R14,GETMAIN_ERROR                                                
         LA    R15,8                                                            
         BR    R12                                                              
@IDS_SKP1 EQU   *                                                               
         ST    R01,@IDF_GETMA            Save Address                           
         L     R02,=A(RV1ALCDL)                                                 
         LR    R15,R01                                                          
@IDS_CLR1 EQU   *                                                               
         CL    R02,=F'256'                                                      
         BNH   @IDS_CLR1X                                                       
         XC    0(256,R15),0(R15)         Null Clear                             
         LA    R15,256(R15)                                                     
         S     R02,=F'256'                                                      
         B     @IDS_CLR1                                                        
@IDS_CLR1X EQU  *                                                               
         STC   R02,*+5                                                          
         XC    0(0,R15),0(R15)           Null Clear                             
         USING RV1ALCD,R01                                                      
         MVC   DA#DISP,=CL3'FRE'         File Free                              
         MVC   DA#RETDD,RV1DDN           Save Input DD                          
         DROP  R01                                                              
         CALL  RV1DALC                   Call Dynamic Alloc Routine             
*                                                                               
         LTR   R15,R15                                                          
         BZ    @IDF_SKP3                                                        
         TPUT  =CL60'*** Free Error ***',60                                     
         L     R01,=A(RV1ALCDL)                                                 
         L     R02,@IDF_GETMA                                                   
         FREEMAIN RC,LV=(R01),A=(R02)    Dynamic Alloc Work Area                
         LA    R15,8                                                            
         BR    R12                        Return                                
@IDF_SKP3 EQU  *                                                                
*                                                                               
         L     R01,=A(RV1ALCDL)                                                 
         L     R02,@IDF_GETMA                                                   
         FREEMAIN RC,LV=(R01),A=(R02)    Dynamic Alloc Work Area                
         XR    R15,R15                                                          
         BR    R12                       Return                                 
@IDF_GETMA DS  F                         Getmain Address                        
*                                        (Dynamic Allocation Work Area)         
*-------------------------------------------------------------------            
*-------- Get Dataset Information ----------------------------------            
*-------------------------------------------------------------------            
@GETDSI  EQU   *                                                                
*        TPUT  RV1DDN,8                                                         
         MVC   PDSFR+X'28'(8),RV1DDN     Extract Data Read DD                   
         MVC   PDSFRPO+X'28'(8),RV1DDN   Extract Data Read DD                   
         MVC   PDSFD+X'28'(8),RV1DDN     Directory Read DD                      
*                                                                               
         LA    R02,RV1DSIDL                                                     
         LA    R15,RV1DSIS                                                      
@GD_LOP1 EQU   *                                                                
         CL    R02,=F'256'                                                      
         BNH   @GD_LOP1X                                                        
         XC    0(256,R15),0(R15)                                                
         LA    R15,256(R15)                                                     
         S     R02,=F'256'                                                      
         B     @GD_LOP1                                                         
@GD_LOP1X EQU  *                                                                
         STC   R02,*+5                                                          
         XC    0(0,R15),0(R15)    Null Clear                                    
*                                                                               
         OPEN  (PDSFD)                   Open Directory and Data Read           
         RDJFCB PDSFD                    Get JFCB                               
         LA    R01,REVIVED               r01 <- Dsect Address                   
         CALL  RV1DSI                    Get Dataset Information                
*-------- Check Input Dataset Organization ( PO File Only ) --------            
         CLI   B#DSORG,JFCORGPO                If Dsorg is Not PO Then          
         BE    @GD_SKP2                          goto @GD_SKP2                  
         CALL  ISPLINK,(SETMSG,REV017),VL                                       
         LA    R15,=F'8'                                                        
         BR    R12                                                              
@GD_SKP2 EQU   *                                                                
         XR    R15,R15                                                          
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------- Directory Table Area GetMain -----------------------------            
*-------------------------------------------------------------------            
@READD   EQU   *                                                                
         L     R02,RV1TBSP               Load Entry Field.                      
         MH    R02,=H'11'                Table Length                           
*                                          8 Byte : Member Name                 
*                                          3 Byte : TTR                         
         ST    R02,RV1TBSPL              Store Length                           
         GETMAIN RC,LV=(R02)             Member TTR Save Area                   
         LTR   R15,R15                                                          
         BNZ   @RD_ERR1                                                         
         ST    R01,RV1TBSPA              Store Address                          
         ST    R01,RV1TBSPP              Store Pointer                          
*-------- Data Area Read Buffer Getmain ----------------------------            
         GETMAIN RC,LV=256               Read Buffer Work Area                  
         LTR   R15,R15                                                          
         BNZ   @RD_ERR2                                                         
         ST    R01,RV1DIRBA              getmain 1 address                      
         ST    R01,RV1DIRBP              getmain 1 address                      
*-------- Directory Read -------------------------------------------            
         XR    R07,R07                   Clear Member Counter                   
         XC    O#DBLK(L'O#DBLK),O#DBLK   Clear Directory Block                  
@RD_READ EQU   *                                                                
         L     R02,RV1DIRBA                                                     
         READ  DECB01,SF,PDSFD,(R02),'S' Read Directory                         
         CHECK DECB01                                                           
*                                                                               
         L     R01,O#DBLK                Directory Block Counter                
         LA    R01,1(R01)                                                       
         ST    R01,O#DBLK                                                       
*                                                                               
         L     R08,RV1DIRBA                                                     
         LH    R01,0(R08)                Load Read Length                       
         LA    R01,0(R08,R01)                                                   
         ST    R01,RV1DENDP              Save Directory END-ADDR                
         LA    R08,2(R08)                Set Member Start Point                 
@RD_LOP1 EQU   *                                                                
         CL    R08,RV1DENDP              If Directory END-ADDR                  
         BNL   @RD_READ                  Goto Read Next Record                  
         CLI   0(R08),X'FF'              If End of Member Name                  
         BE    @RD_READ                    Goto Read Next Record                
         L     R01,RV1TBSPP              R11 <- Table Pointer                   
         MVC   0(11,R01),0(R08)          Copy Member Name and TTR               
         LA    R01,11(R01)                                                      
         ST    R01,RV1TBSPP              Store Table Pointer                    
         LA    R07,1(R07)                Member Counter + 1                     
         L     R01,RV1TBSPA                                                     
         L     R02,RV1TBSPL                                                     
         LA    R01,0(R01,R02)            Check End of Table Space               
         CL    R01,RV1TBSPP              If No More Table                       
         BL    @TB_OVER                    Goto @TB_OVER                        
*                                                                               
         IC    R01,11(R08)               Load 'C'                               
         N     R01,=X'0000001F'          User Data Length                       
         SLL   R01,1                       * 2                                  
         LA    R08,12(R08,R01)           Point Next Member                      
         B     @RD_LOP1                                                         
*-------- End of Directory ( Directory at end Routie ) -------------            
@RD_EXIT EQU   *                                                                
*-------- Store Member Number --------------------------------------            
         ST    R07,O#MEM                                                        
*-------- Point First Data Area ------------------------------------            
         NOTE  PDSFD                     Get Last Directory Addr                
         ST    R01,B#ADP                                                        
         MVI   B#ADP+3,X'00'                                                    
*-------- Store Member Number --------------------------------------            
         CALL  RV1BTH,(B#ADP,O#ADP2,3)                                          
         L     R00,B#ADP                 MBBCCHHR Convert                       
         N     R00,=X'FFFFFF00'                                                 
         L     R01,PDSFD+44              Load DEB Address                       
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,W_CHR                                                        
         BAL   R14,@CNVCHR               Convert TTR -> MBBCCHHR                
         CALL  RV1BTH,(W_CHR,O#ADP,8)                                           
         XR    R15,R15                                                          
         BR    R12                                                              
*--------- Directory Table Space GETMAIN faile ---------------------            
@RD_ERR1 EQU   *                                                                
         ST    R15,WK#F                         Set  GETMAIN Code               
         CALL  RV1BTH,(WK#F,ERRMSG15+36,4)                                      
         LA    R02,RV1TBSPL                     Set GETMAIN Length              
         CALL  RV1BTH,((R02),ERRMSG15+52,4)                                     
         MVC   ZEDLMSG,ERRMSG15                                                 
         MVC   ZEDSMSG,=CL20'Table to Large'                                    
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         BR    R12                                                              
*-------- Read Buffer Getmain False --------------------------------            
@RD_ERR2 EQU   *                                 GETMAIN ERROR                  
         ST    R15,WK#F                         Set  GETMAIN Code               
         CALL  RV1BTH,(WK#F,ERRMSG16+36,4)                                      
         LA    R02,RV1TBSPL                     Set GETMAIN Length              
         CALL  RV1BTH,((R02),ERRMSG16+52,4)                                     
         L     R02,RV1TBSPL                                                     
         L     R01,RV1TBSPA                                                     
         FREEMAIN RC,LV=(R02),A=(R01)                                           
         MVC   ZEDLMSG,ERRMSG16                                                 
         MVC   ZEDSMSG,=CL20'Getmain Faile.'                                    
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         BR    R12                                                              
*-------------------------------------------------------------------            
*--- List Panel Display --------------------------------------------            
*-------------------------------------------------------------------            
PDISPLAY EQU   *                                                                
         L     R15,DTLASTE                                                      
         LTR   R15,R15                                                          
         BNZ   PD#SKP0                                                          
         MVC   DISPLAYRC,=F'16'                                                 
         BR    R12                                                              
PD#SKP0  EQU   *                                                                
*-------------------------------------------------------------------            
* Display Work Area Space Clear.                                                
*-------------------------------------------------------------------            
         L     R01,RV1DAREAA             Display Area Space Clear               
         L     R02,RV1DAREAL                                                    
         MVI   0(R01),C' '                                                      
         BCTR  R02,0                                                            
PD#CLS   EQU   *                                                                
         CL    R02,=F'256'                                                      
         BNH   PD#CLSX                                                          
         MVC   1(256,R01),0(R01)                                                
         LA    R01,256(R01)                                                     
         S     R02,=F'256'                                                      
         B     PD#CLS                                                           
PD#CLSX  EQU   *                                                                
         STC   R02,*+5                                                          
         MVC   1(0,R01),0(R01)                                                  
*-------------------------------------------------------------------            
* Search Target Table Row.                                                      
*   R09(DTPOSIT) : Target Row.                                                  
*   R08          : Processing Table Address                                     
* Row Re-Positioning.                                                           
*   DTPOSIT > DTLASTE : DTLASTE - VDEPTH -1 -> DTPOSIT                          
*   DTPOSIT < 1       : 1                   -> DTPOSIT                          
*-------------------------------------------------------------------            
         L     R09,DTPOSIT                                                      
         CL    R09,DTLASTE                                                      
         BNH   PD#POS1                                                          
         L     R09,DTLASTE                                                      
         LA    R09,3(R09)                                                       
         CL    R09,VDEPTH                                                       
         BNH   PD#POS0                                                          
         S     R09,VDEPTH                                                       
*        BCTR  R09,0                                                            
         B     PD#POS1                                                          
PD#POS0  EQU   *                                                                
         LA    R09,1                                                            
PD#POS1  EQU   *                                                                
         CL    R09,=F'1'                                                        
         BNL   PD#POS2                                                          
         LA    R09,1                                                            
PD#POS2  EQU   *                                                                
         ST    R09,DTPOSIT                                                      
*DEBUG*                                                                         
*        MVC   MSG999+12(68),=CL68'DTPOSIT:'                                    
*        CALL  RV1BTH,(DTPOSIT,MSG999+20,4)                                     
*        CALL  RV1BTH,(VDEPTH,MSG999+30,4)                                      
*        CALL  RV1BTH,(DTLASTE,MSG999+40,4)                                     
*        TPUT  MSG999,80                                                        
*DEBUG*                                                                         
         L     R08,DTFIRST                                                      
         USING DTHEADER,R08                                                     
PD#POSIT EQU   *                                                                
         CL    R09,DTHPOSL                                                      
         BNH   PD#POSITX                                                        
         L     R08,DTHNEXT                                                      
         B     PD#POSIT                                                         
PD#POSITX EQU  *                                                                
         S     R09,DTHPOSF                                                      
         LA    R15,DTELAST                                                      
         STH   R15,WK#H                                                         
         MH    R09,WK#H                                                         
         LA    R09,DTHL(R09,R08)                                                
         USING DTENTRY,R09                                                      
* ---------------------------------------------------------------               
* Write Rows Calc.                                                              
*   Tbl-Rows  Current-Pos       Win-Depth     Write-Row                         
*   DTLASTE - DTPOSIT + 1   <   VDEPTH   ->   DTPOSIT                           
*   DTLASTE - DTPOSIT + 1   >   VDEPTH   ->   VDEPTH                            
*   DTLASTE - DTPOSIT + 1   =   VDEPTH   ->   VDEPTH ( or DTPOSIT )             
* ---------------------------------------------------------------               
         L     R07,DTLASTE                                                      
         S     R07,DTPOSIT                                                      
         LA    R07,1(R07)                                                       
         CL    R07,VDEPTH                                                       
         BL    PD#ROWC                                                          
         L     R07,VDEPTH                Rows (Loop Counter).                   
PD#ROWC  EQU   *                                                                
         L     R10,RV1DAREAA             R10 <- Screen Buffer                   
PD#LOP1  EQU   *                                                                
         MVI   00(R10),ATTR_INP                                                 
         MVC   02(01,R10),DTEATTR                                               
         MVC   03(08,R10),DTENAME                                               
         MVC   11(1,R10),DTEDATTR                                               
         MVC   12(06,R10),DTETTR                                                
         MVC   19(60,R10),DTEDATA                                               
*                                                                               
         L     R01,VWIDTH                                                       
         LA    R10,0(R10,R01)                                                   
         LA    R09,DTELAST(R09)                                                 
*                                                                               
         LA    R01,DTELAST(R09)                                                 
         L     R15,=A(DTLENGTH)                                                 
         LA    R15,0(R08,R15)                                                   
         CLR   R15,R01                                                          
         BNL   PD#SKP1                                                          
*                                                                               
         L     R08,DTHNEXT                                                      
         LA    R09,DTHL(R08)                                                    
PD#SKP1  EQU   *                                                                
         BCT   R07,PD#LOP1                                                      
         DROP  R08,R09                                                          
* END OF LIST Mark                                                              
         L     R01,VWIDTH                                                       
         LA    R01,0(R10,R01)                                                   
         CL    R01,RV1DAREAL                                                    
         BNH   PD#SKP2                                                          
         MVC   0(L'MSGLAST,R10),MSGLAST                                         
PD#SKP2  EQU   *                                                                
         CALL  ISPLINK,(DISPLAY,PANELLST),VL                                    
         ST    R15,DISPLAYRC                                                    
*-------------------------------------------------------------------            
*        CALL  ISPLINK,(VGET,RV1DAREAN,ASIS),VL                                 
*        L     R01,RV1DAREAA                                                    
*        TPUT  (R01),80                                                         
         BR    R12                                                              
DISPLAYRC DS   F                                                                
*-------------------------------------------------------------------            
* List Panel Scroll.                                                            
*-------------------------------------------------------------------            
PSCROLL  EQU   *                                                                
         CALL  ISPLINK,(VGET,RV1SCROLL,ASIS),VL  Get Scroll Variable            
         CLC   ZVERB(8),=CL8'UP      '                                          
         BE    PSCR#UP                                                          
         CLC   ZVERB(8),=CL8'DOWN    '                                          
         BE    PSCR#DW                                                          
         B     PSCROLLQ                                                         
PSCR#DW  EQU   *                                                                
         CLC   ZSCROLLA,=CL4'MAX'                                               
         BNE   PSCR#DW1                                                         
*        Max Down                                                               
         L     R09,DTLASTE                                                      
         LA    R09,3(R09)                                                       
         CL    R09,VDEPTH                                                       
         BNH   PSCR#DW0                                                         
         S     R09,VDEPTH                                                       
         B     PSCROLLX                                                         
PSCR#DW0 EQU   *                                                                
         LA    R09,1                                                            
         B     PSCROLLX                                                         
PSCR#DW1 EQU   *                                                                
*        Down                                                                   
         L     R09,DTPOSIT                                                      
         A     R09,ZSCROLLN                                                     
         B     PSCROLLX                                                         
PSCR#UP  EQU   *                                                                
         CLC   ZSCROLLA,=CL4'MAX'                                               
         BNE   PSCR#UP1                                                         
*        Max Up                                                                 
         LA    R09,1                                                            
         B     PSCROLLX                                                         
PSCR#UP1 EQU   *                                                                
*        Up                                                                     
         L     R09,DTPOSIT                                                      
         CL    R09,ZSCROLLN                                                     
         BNH   PSCR#UP2                                                         
         S     R09,ZSCROLLN                                                     
         B     PSCROLLX                                                         
PSCR#UP2 EQU   *                                                                
         LA    R09,1                                                            
PSCROLLX EQU   *                                                                
         ST    R09,DTPOSIT                                                      
PSCROLLQ EQU   *                                                                
         BR    R12                                                              
*-------------------------------------------------------------------            
* Data Table Freemain.                                                          
*-------------------------------------------------------------------            
TBLFREE  EQU   *                                                                
         L     R07,DTFIRST                                                      
         LTR   R07,R07                                                          
         BZ    TF#NOTF                                                          
         USING DTHEADER,R07                                                     
TF#LOP1  EQU   *                                                                
*DEBUG*                                                                         
*        MVC   MSG999+12(68),=CL68'FREE   :'                                    
*        L     R01,DTHPOSF                                                      
*        ST    R01,WK#F                                                         
*        CALL  RV1BTH,(WK#F,MSG999+20,4)                                        
*        L     R01,DTHPOSL                                                      
*        ST    R01,WK#F                                                         
*        CALL  RV1BTH,(WK#F,MSG999+30,4)                                        
*        L     R01,DTHNEXT                                                      
*        ST    R01,WK#F                                                         
*        CALL  RV1BTH,(WK#F,MSG999+40,4)                                        
*        L     R01,DTHPREV                                                      
*        ST    R01,WK#F                                                         
*        CALL  RV1BTH,(WK#F,MSG999+50,4)                                        
*        TPUT  MSG999,80                                                        
*DEBUG*                                                                         
         LR    R08,R07                                                          
         L     R07,DTHNEXT                                                      
         L     R09,=A(DTLENGTH)                                                 
         FREEMAIN RC,LV=(R09),A=(R08)    Dynamic Alloc Work Area                
         LTR   R15,R15                                                          
         BNZ   TF#ERR                                                           
         LTR   R07,R07                                                          
         BNZ   TF#LOP1                                                          
         DROP  R07                                                              
         BR    R12                                                              
TF#ERR   EQU   *                                                                
         TPUT  =CL20'FREEM ERR',20                                              
         BR    R12                                                              
TF#NOTF  EQU   *                                                                
         BR    R12                                                              
*-------------------------------------------------------------------            
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'                                                       
*-------------------------------------------------------------------            
* List Panel Command Proecss.                                                   
*-------------------------------------------------------------------            
PCMDPROC EQU   *                                                                
         L     R10,RV1DAREAA                                                    
         L     R09,VDEPTH                                                       
         L     R08,DTPOSIT                                                      
PC#LOP1  EQU   *                                                                
         CLI   1(R10),C' '                                                      
         BE    PC#LOP1N                                                         
         MVC   PC@CMD(1),1(R10)                                                 
         MVC   PC@NNAME(8),3(R10)                                               
*                                                                               
         LR    R01,R08                                                          
         L     R02,DTFIRST                                                      
         USING DTHEADER,R02                                                     
PC#POSIT EQU   *                                                                
         CL    R01,DTHPOSL                                                      
         BNH   PC#POSITX                                                        
         L     R02,DTHNEXT                                                      
         B     PC#POSIT                                                         
PC#POSITX EQU  *                                                                
         S     R01,DTHPOSF                                                      
         LA    R15,DTELAST                                                      
         STH   R15,WK#H                                                         
         MH    R01,WK#H                                                         
         LA    R01,DTHL(R01,R02)                                                
         USING DTENTRY,R01                                                      
         MVC   PC@NAME(8),DTENAME                                               
         MVC   PC@TTR(6),DTETTR                                                 
         MVC   PC@TTRB(4),DTETTRB                                               
         MVC   PC@RECD(4),DTERECD                                               
         MVC   PC@ATTR(1),DTEATTR                                               
         MVC   PC@RLNG(2),DTERLNG                                               
         MVC   PC@LRL(2),DTELRL                                                 
         MVC   PC@BSZ(2),DTEBSZ                                                 
         MVC   PC@RFM(1),DTERFM                                                 
         DROP  R01,R02                                                          
*-------------------------------------------------------------------            
         MVC   WKMES,=CL80' > '                                                 
         CALL  RV1BTH,(PC@RLNG,WKMES+10,2)                                      
         CALL  RV1BTH,(PC@LRL,WKMES+20,2)                                       
         CALL  RV1BTH,(PC@BSZ,WKMES+30,2)                                       
         CALL  RV1BTH,(PC@RFM,WKMES+40,1)                                       
         CALL  RV1BTH,(B#RECFM,WKMES+50,1)                                      
*        TPUT  WKMES,80                                                         
         MVC   PC@MSG+20(1),PC@CMD                                              
         MVC   PC@MSG+22(8),PC@NAME                                             
         MVC   PC@MSG+31(2),=CL2'->'                                            
         MVC   PC@MSG+35(8),PC@NNAME                                            
         MVC   PC@MSG+44(6),PC@TTR                                              
*        TPUT  PC@MSG,80                                                        
*-------------------------------------------------------------------            
         STM   R01,R14,PC@REGS                                                  
         CLI   PC@CMD,C'B'                                                      
         BNE   PC#CMDPROC1                                                      
         BAL   R12,@BROWSE                                                      
         B     PC#CMDPROCX                                                      
PC#CMDPROC1 EQU *                                                               
         CLI   PC@CMD,C'R'                                                      
         BNE   PC#CMDPROC2                                                      
         BAL   R12,@RESTORE                                                     
         B     PC#CMDPROCX                                                      
PC#CMDPROC2 EQU *                                                               
         CLI   PC@CMD,C'X'                                                      
         BNE   PC#CMDPROC3                                                      
         BAL   R12,@EXTRACT                                                     
         B     PC#CMDPROCX                                                      
PC#CMDPROC3 EQU *                                                               
         CLI   PC@CMD,C'S'                                                      
         BNE   PC#CMDPROC4                                                      
         CALL  ISPLINK,(SETMSG,REV990),VL                                       
         B     PC#CMDPROCX                                                      
PC#CMDPROC4 EQU *                                                               
PC#CMDPROCX EQU *                                                               
         LM    R01,R14,PC@REGS                                                  
*-------------------------------------------------------------------            
PC#LOP1N EQU   *                                                                
         LA    R08,1(R08)                                                       
         L     R01,VWIDTH                                                       
         LA    R10,0(R10,R01)                                                   
         BCT   R09,PC#LOP1                                                      
         XR    R15,R15                                                          
         BR    R12                                                              
PC@CMD   DS    CL1                                                              
PC@NAME  DS    CL8                                                              
PC@NNAME DS    CL8                                                              
PC@TTR   DS    CL6                                                              
         DS    0F                                                               
PC@TTRB  DS    XL4                       TTR ( Binary )                         
         DS    0F                                                               
PC@RECD  DS    XL4                       Record Number                          
PC@RLNG  DS    XL2                       Logical Record Length(For F)           
PC@LRL   DS    XL2                       Logical Record Length(For V)           
PC@BSZ   DS    XL2                       Phisical Record Length(BLKSZ)          
PC@RFM   DS    XL1                       Record Format Flag.                    
PC@ATTR  DS    XL1                       Attribute                              
PC@REGS  DS    18F                       Attribute                              
PC@MSG   DC    CL80'>>> Member Process :'                                       
*-------------------------------------------------------------------            
*--------- Member Stow ( Add New Member ) --------------------------            
*-------------------------------------------------------------------            
@STOW_A  EQU   *                                                                
         MVC   S_TTR(3),STOW_TTR                                                
         MVC   S_MEMBER(8),STOW_NAME                                            
         MVC   PDSFS+X'28'(8),RV1DDN     Stow DD                                
         OPEN  (PDSFS,(OUTPUT))                                                 
         STOW  PDSFS,ST#LIST,A                                                  
         ST    R15,STOW_RC                                                      
         ST    R00,STOW_RSN                                                     
         CLOSE (PDSFS)                                                          
         L     R15,STOW_RC                                                      
         L     R00,STOW_RSN                                                     
         BR    R11                                                              
*-------------------------------------------------------------------            
*--------- Member Stow ( Remove Work Member ) ----------------------            
*-------------------------------------------------------------------            
@STOW_D  EQU   *                                                                
         MVC   S_TTR(3),STOW_TTR                                                
         MVC   S_MEMBER(8),STOW_NAME                                            
         MVC   PDSFS+X'28'(8),RV1DDN     Stow DD                                
         OPEN  (PDSFS,(OUTPUT))                                                 
         STOW  PDSFS,ST#LIST,D                                                  
         ST    R15,STOW_RC                                                      
         ST    R00,STOW_RSN                                                     
         CLOSE (PDSFS)                                                          
         L     R15,STOW_RC                                                      
         L     R00,STOW_RSN                                                     
         BR    R11                                                              
*-------------------------------------------------------------------            
*-------- Member Browse --------------------------------------------            
*-------------------------------------------------------------------            
@BROWSE  EQU   *                                                                
         TM    PC@RFM,X'40'                                                     
         BO    @BR_SKP3                                                         
         CLI   PC@ATTR,ATTR_CUR                                                 
         BE    @BR_SKP1                                                         
         MVC   STOW_TTR,PC@TTRB                                                 
         MVC   STOW_NAME,PC@NAME                                                
         BAL   R11,@STOW_A                                                      
         LTR   R15,R15                                                          
         BZ    @BR_SKP1                                                         
         LA    R01,BROWSE_STOW_ERROR                                            
@BR_LOP0 EQU   *                                                                
         CLC   0(4,R01),=F'0'                                                   
         BE    @BR_LOP0E                                                        
         CL    R15,0(R01)                                                       
         BNE   @BR_LOP0N                                                        
         CL    R00,4(R01)                                                       
         BNE   @BR_LOP0N                                                        
@BR_LOP0E EQU   *                                                               
         LA    R01,8(R01)                                                       
         CALL  ISPLINK,(SETMSG,(R01)),VL                                        
         BR    R12                       Return !                               
@BR_LOP0N EQU   *                                                               
         LA    R01,BROWSE_STOW_ERROR_LENGTH(R01)                                
         B     @BR_LOP0                                                         
@BR_SKP1 EQU   *                                                                
         MVI   BR#DSN,C''''                                                     
         MVC   BR#DSN+1(44),RV1DSNC                                             
         LA    R07,BR#DSN+1                                                     
@BR_LOP1 EQU   *                                                                
         CLI   0(R07),X'40'                                                     
         BE    @BR_LOPX                                                         
         LA    R07,1(R07)                                                       
         B     @BR_LOP1                                                         
@BR_LOPX EQU   *                                                                
         MVI   0(R07),C'('                                                      
         LA    R07,1(R07)                                                       
         MVC   0(8,R07),PC@NAME                                                 
@BR_LOP2 EQU   *                                                                
         CLI   0(R07),C' '                                                      
         BE    @BR_LOPY                                                         
         LA    R07,1(R07)                                                       
         B     @BR_LOP2                                                         
@BR_LOPY EQU   *                                                                
         MVI   0(R07),C')'                                                      
         MVI   1(R07),C''''                                                     
         MVC   BR#VOL(6),RV1TVOL                                                
         CALL  ISPLINK,(BROWSE,BR#DSN,BR#VOL),VL                                
         CLI   PC@ATTR,ATTR_CUR                                                 
         BE    @BR_SKP2                                                         
         BAL   R11,@STOW_D                                                      
@BR_SKP2 EQU   *                                                                
*        CALL  ISPLINK,(VPUT,VPUT#N),VL                                         
*        CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         BR    R12                                                              
@BR_SKP3 EQU   *                                                                
         CALL  ISPLINK,(SETMSG,REV016),VL                                       
         BR    R12                       Return !                               
*-------------------------------------------------------------------            
*-------- Member Restore -------------------------------------------            
*-------------------------------------------------------------------            
@RESTORE EQU   *                                                                
         TM    PC@RFM,X'40'              Invalid DCB Information                
         BO    @RST_INVALID                                                     
         CLI   PC@ATTR,ATTR_CUR          Currently Exist.                       
         BE    @RST_EXT                                                         
         CLI   PC@ATTR,ATTR_REC          Over DS1LSTAR line                     
         BNE   @RST_OVR                                                         
*--- Member Name Check ---------------------------------------------            
         MVC   RV1EMN,PC@NNAME                                                  
         CALL  ISPLINK,(CONTROL,NONDISPL,ENTER),VL Panel Lock                   
         CALL  ISPLINK,(ADDPOP),VL       Make Popup Panel                       
         CALL  ISPLINK,(DISPLAY,PANELMCH),VL Member Name Check Panel            
         ST    R15,PANELRC                                                      
         CALL  ISPLINK,(REMPOP),VL       Remove Popup Panel                     
         CLC   PANELRC,=F'0'                                                    
         BE    @RS_SKP0                                                         
         BR    R12                                                              
@RS_SKP0 EQU   *                                                                
*-------------------------------------------------------------------            
         MVC   STOW_TTR,PC@TTRB          Copy TTR                               
         MVC   STOW_NAME,RV1EMN          Copy Member name                       
*--- Member Stow ---------------------------------------------------            
         BAL   R11,@STOW_A               call STOW                              
         LTR   R15,R15                   if not Error ?                         
         BZ    @RS_SKP1                    goto @RS_SKP1                        
         LA    R01,BROWSE_STOW_ERROR     Error Message Table Address            
*--- STOW Error process --------------------------------------------            
@RS_LOP0 EQU   *                                                                
         CLC   0(4,R01),=F'0'            If Table end ?                         
         BE    @RS_LOP0E                                                        
         CL    R15,0(R01)                RC Table not Match !                   
         BNE   @RS_LOP0N                                                        
         CL    R00,4(R01)                RSN Table not Match !                  
         BNE   @RS_LOP0N                                                        
@RS_LOP0E EQU  *                                                                
         LA    R01,8(R01)                Set Message                            
         CALL  ISPLINK,(SETMSG,(R01)),VL                                        
         BR    R12                       Return !                               
@RS_LOP0N EQU  *                         Next Table Entry.                      
         LA    R01,BROWSE_STOW_ERROR_LENGTH(R01)                                
         B     @RS_LOP0                                                         
*                                                                               
*--- Notmal end ----------------------------------------------------            
@RS_SKP1 EQU   *                                                                
         CALL  ISPLINK,(VREPLACE,M1N,L8,STOW_NAME),VL                           
         CALL  ISPLINK,(SETMSG,REV014),VL                                       
         BR    R12                       Return !                               
*--- Currentry Exits -----------------------------------------------            
@RST_EXT EQU   *                                                                
         CALL  ISPLINK,(VREPLACE,M1N,L8,PC@NAME),VL                             
         CALL  ISPLINK,(SETMSG,REV015),VL                                       
         BR    R12                       Return !                               
*--- Over DS1LSTAR Line --------------------------------------------            
@RST_OVR EQU   *                                                                
         CALL  ISPLINK,(ADDPOP),VL       Make Popup Panel                       
         CALL  ISPLINK,(DISPLAY,PANELEXTQ),VL Perform Extract Function          
         ST    R15,PANELRC                                                      
         CALL  ISPLINK,(REMPOP),VL       Remove Popup Panel                     
         L     R15,PANELRC                                                      
         LTR   R15,R15                   If OK ?                                
         BZ    @EXTRACT                                                         
         BR    R12                                                              
*--- Contains Invalid Records --------------------------------------            
@RST_INVALID EQU *                                                              
         CALL  ISPLINK,(SETMSG,REV016),VL                                       
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------- Member Extract -------------------------------------------            
*-------------------------------------------------------------------            
WKMES    DC    CL80'>>'                                                         
@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                                                          
         STC   R15,*+5                                                          
         MVC   RV1EREC(0),0(R01)                                                
*                                                                               
         TM    PC@RFM,X'40'                                                     
         BO    @EXT_CALC_SKP0                                                   
         CALL  RV1TC,(RV1TVOL,O#BLKSZ,RV1TRKCB)                                 
         B     @EXT_CALC_SKP0X                                                  
@EXT_CALC_SKP0 EQU *                                                            
         CALL  RV1TC,(RV1TVOL,PC@BSZ,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                                                          
         STC   R15,*+5                                                          
         MVC   RV1TRKC(0),0(R01)                                                
*                                                                               
         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                                                          
         STC   R15,*+5                                                          
         MVC   RV1CSPT(0),0(R01)                                                
         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  Get TSO Prefix               
*                                                                               
         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 *                                                            
         MVC   0(2,R01),=CL2'.M'                                                
         MVC   2(6,R01),PC@TTR                                                  
         MVI   8(R01),C''''                                                     
         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'                                                     
         BO    @EXT_CALC_SKP3                                                   
         MVC   RV1ERF,O#RECFM                                                   
         MVC   RV1ERL,O#LRECL                                                   
         MVC   RV1EBS,O#BLKSZ                                                   
         B     @EXT_CALC_SKP3X                                                  
@EXT_CALC_SKP3 EQU *                                                            
         TM    B#RECFM,RECFM_V                                                  
         BO    @EXT_CALC_SKP31                                                  
         TM    B#RECFM,RECFM_F                                                  
         BO    @EXT_CALC_SKP32                                                  
* ---RECFM : U ---                                                              
         MVC   RV1ERF,O#RECFM                                                   
         XC    RV1ERL,RV1ERL                                                    
         MVC   RV1EBS,PC@BSZ                                                    
         B     @EXT_CALC_SKP3X                                                  
* ---RECFM : V ---                                                              
@EXT_CALC_SKP31 EQU *                                                           
         MVC   RV1ERF,O#RECFM                                                   
         MVC   RV1ERL,PC@LRL                                                    
         MVC   RV1EBS,PC@BSZ                                                    
         B     @EXT_CALC_SKP3X                                                  
* ---RECFM : F ---                                                              
@EXT_CALC_SKP32 EQU *                                                           
         MVC   RV1ERF,O#RECFM                                                   
         MVC   RV1ERL,PC@RLNG                                                   
         MVC   RV1EBS,PC@BSZ                                                    
         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                                                 
         BR    R12                                                              
@EXT_PNLX 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 @ID_SKP0                        
         BAL   R14,GETMAIN_ERROR                                                
         LA    R15,8                                                            
         BR    R12                                                              
@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)                                                       
         STC   R15,*+5                                                          
         MVC   0(0,R10),2(R02)                                                  
*                                                                               
         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                               
         BR    R12                                                              
@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                               
         BR    R12                                                              
         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          
         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,REV019),VL                                       
         BR    R12                                                              
*-------------------------------------------------------------------            
@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                                                         
*                                                                               
         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,REV019),VL                                       
         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                
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
@DC_REGS DS    18F                                                              
@DS_CONV EQU   *                                                                
         STM   R00,R14,@DC_REGS                                                 
         LR    R07,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(R07),C''''              If Quotation                           
         BE    @DC_SKP1                    goto @DC_SKP1                        
         CALL  ISPLINK,(VGET,ZPREFIXN,ASIS),VL  Get TSO Prefix                  
         LA    R01,ZPREFIX               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,ZPREFIX               Calculate Prefix Length                
         SR    R01,R15                                                          
         STC   R01,*+5                                                          
         MVC   0(0,R08),ZPREFIX          Copy TSO Prefix                        
         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,R07                   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                                                          
         STC   R01,*+5                                                          
         MVC   0(0,R08),0(R07)           Coopy Dataset Name                     
         B     @DC_SKP2                  goto Next                              
@DC_SKP1 EQU   *                         Quotation !                            
         LA    R01,1(R07)                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                                                            
         STC   R01,*+5                                                          
         MVC   0(0,R08),1(R07)           Copy DSN                               
@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                                                              
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
*-------- Recover Dataset ENQ ( Exclusive ) -----------------------             
*+       MVC   RNAME(44),@RV#DSN               ENQ rname                        
*+       ENQ   MF=(E,@ENQ)                                                      
*+       LTR   R15,R15                                                          
*+       BNZ   ENQ_ER0                                                          
*-------- Allocate & Initialization --------------------------------            
@ENT_QUT EQU   *                                                                
*-------- TTR and MBBCCHHR Message Display -------------------------            
@ADDRESS EQU   *                                                                
*+       MVC   ERRMSG14+6(6),O#TTR                                              
*+       CALL  RV1BTH,(O#MBCHR,ERRMSG14+24,8)                                   
*+       MVC   ZEDSMSG(20),=CL20' '                                             
*+       MVC   ZEDLMSG(60),ERRMSG14                                             
*+       B     @D_CMD_X                                                         
*                                                                               
*+       CALL  ISPLINK,(DISPLAY,PANELINF),VL   information panel                
*+       B     @D_CMD_X                                                         
*-------- Member Restore -------------------------------------------            
*--------- Directory Table Over Flow -------------------------------            
@TB_OVER EQU   *                                                                
         TPUT  =CL50'*** DIRECTORY TABLE OVER ***',50                           
         ABEND 1                                                                
*+       CLOSE (PDSFD)                          Close Recover File              
*+       L     R02,RV1TBSPL                                                     
*+       L     R12,RV1TBSPA                                                     
*+       FREEMAIN RC,LV=(R02),A=(R12)           FreeMain Direct Table           
*+       MVC   DA#PROC(8),=CL8'FREE    '                                        
*+       MVC   DA#RETDD(8),@RV#DD                                               
*+       LA    R01,DA#AREA                                                      
*+       L     R15,@RV#6DA                                                      
*+       BALR  R14,R15                          Recover File De-Alloc           
*+       DEQ   MF=(E,@DEQ)                      DEQ                             
*+       LA    R02,RV1TBSPA                                                     
*+       CALL  RV1BTH,((R02),ERRMSG03+29,4)                                     
*+       LA    R02,RV1TBSPL                                                     
*+       CALL  RV1BTH,((R02),ERRMSG03+40,4)                                     
*+       LA    R02,RV1TBSPP                                                     
*+       CALL  RV1BTH,((R02),ERRMSG03+51,4)                                     
*+       MVC   ZEDLMSG,ERRMSG03                                                 
*+       MVC   ZEDSMSG,=CL20'Table OverFlow'                                    
*+       CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
*+       B     SHOW_ENT                         Return Entry Panel              
*--------- Recovery Dataset ENQ Check ------------------------------            
ENQ_ER0  EQU   *                                                                
*        ST    R15,WK#F                         Set  ENQ Code                   
*+       CALL  RV1BTH,((15),ERRMSG16+47,4)                                      
*+       MVC   ZEDLMSG,ERRMSG16                                                 
*+       MVC   ZEDSMSG,=CL20'Recover Faile'                                     
*+       CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
*+       B     SHOW_ENT                         Return Entry Panel              
*-------------------------------------------------------------------            
*-------- 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     R10,CVTPTR                                                       
         USING CVTMAP,R10                                                       
         L     R15,CVTPCNVT                                                     
         DROP  R10                                                              
         BALR  R14,R15                                                          
         LM    R03,R15,REGS                                                     
         BR    R14                                                              
*-------------------------------------------------------------------            
*-------- i/o error routine ( ps ) ---------------------------------            
*-------------------------------------------------------------------            
IOERR_S  EQU   *                                                                
         SYNADAF ACSMETH=BSAM                  I/O ERROR                        
         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                                                           
*        LR    R12,R01                                                          
*        B     @IOERR                                                           
*-------------------------------------------------------------------            
*-------- i/o error routine ( po ) ---------------------------------            
*-------------------------------------------------------------------            
IOERR_P  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_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                                                          
*-------------------------------------------------------------------            
*-------- Dataset Configratin Block --------------------------------            
*-------------------------------------------------------------------            
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                               
PDSFD    DCB   DSORG=PS,MACRF=(RP),DDNAME=@@@@,BLKSIZE=256,            *        
               SYNAD=IOERR_S,EODAD=@RD_EXIT,RECFM=F,EXLST=EXLST                 
         ENTRY PDSFD                                                            
EXLST    DC    X'87',AL3(RV1JFCB)                                               
*DSF     DCB   DSORG=PO,MACRF=(R),DDNAME=@@@@,DEVD=DA,                 *        
               SYNAD=IOERR_P,EODAD=@M_NEXT,EXLST=EXLST                          
PDSFS    DCB   DSORG=PO,MACRF=W,DDNAME=@@@@,                           *        
               SYNAD=IOERR_W                                                    
*                                                                               
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                       
* --- Work Area ---                                                             
WK#F     DS    F                                                                
* --- Register Save ( work ) area ---                                           
REGS     DS    18F                               WORK SAVEAREA                  
CMD#REG  DS    18F                               WORK SAVEAREA                  
         DS    0D                                                               
EXTRBUFA DS    F                                                                
* --- V con ---                                                                 
*RV#6DA  DC    V(@RV#6DA)                                                       
*RV#6DC  DC    V(@RV#6DC)                                                       
         DS    0D                                                               
* --- Panel RC Packed Area ---                                                  
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                                                             
         DS    0F                                                               
* --- Condition Code ---                                                        
RC#      DS    F                                                                
SPC1     DS    F                                                                
SPC2     DS    F                                                                
* --- ENQ And DEQ List Function ---                                             
QNAME    DC    CL8'@REVIVE'                                                     
RNAME    DS    CL44                                                             
@ENQ     ENQ   (QNAME,RNAME,E,44,SYSTEMS),RET=USE,MF=L                          
@DEQ     DEQ   (QNAME,RNAME,44,SYSTEMS),MF=L                                    
PANELINF DC    CL8'@RV#INF '                     ISPF PANEL ( INFO )            
PANELEXTQ DC   CL8'REV@EXTQ'                     ISPF PANEL ( INFO )            
PANELEXTR DC   CL8'REV@EXTR'                     ISPF PANEL ( INFO )            
PANELRC  DS    F                                                                
ZCMD     DS    CL80                              command line                   
* -----------------------------------                                           
         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                                                               
* --- Browse DataSet Name ---                                                   
BR#DSN   DS    CL46                                                             
         DS    XL10                                                             
BR#VOL   DS    CL6                                                              
* --- Restore DataSet Name ---                                                  
         ENTRY R#DSN                                                            
R#DSN    DS    CL44                                                             
* --- Restore Volume Serial ---                                                 
         ENTRY R#VOL                                                            
R#VOL    DS    CL6                                                              
*#DD     DS    CL8                                                              
R_LEN    DS    F                           data area read length                
@ID_GETMA DS   F                          Getmain Address                       
REV011   DC    CL8'REV011'                                                      
REV012   DC    CL8'REV012'                                                      
REV013   DC    CL8'REV013'                                                      
REV014   DC    CL8'REV014'                                                      
REV015   DC    CL8'REV015'                                                      
REV016   DC    CL8'REV016'                                                      
REV017   DC    CL8'REV017'                                                      
REV018   DC    CL8'REV018'                                                      
REV019   DC    CL8'REV019'                                                      
REV990   DC    CL8'REV990'                                                      
DYRETCC  DS    CL4                                                              
DYINFOC  DS    CL4                                                              
L4       DC    F'4'                                                             
L8       DC    F'8'                                                             
DAMSGA   DS    F                                                                
DAMSGL   DS    F                                                                
* --- check of logical record length ---                                        
         DS    0F                                                               
         ENTRY CK#LRECL                                                         
CK#LRECL DS    BL2                                                              
* --- work of ttr ---                                                           
W_TTR    DS    0F,XL4                            work ttr                       
* --- work of mbbcchhr ---                                                      
W_CHR    DS    0F,XL8                            end of mbbcchhr                
         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 ---                                                               
*RRMSG99 DC    CL60' '                                                          
*RRMSG01 DC    CL30' << Getmain Error >>'        GETMAIN ERROR MESSAGE          
*RRMSG02 DC    CL60'< Dynamic Allocation Error rc_@@@@@@@@ >'                   
*                   |....+....1....+....2....+....3....+....4....+....5         
*              ....+....6....+....7....+....8                                   
ERRMSG03 DS    0CL75                                                            
         DC    CL27'Directory Table OverFlow . '                                
         DC    CL48'A:@@@@@@@@ L:@@@@@@@@ P:@@@@@@@@'                           
ERRMSG04 DC    CL60'< I/O Error TTR:@@@@@@ @@@@@@@@@@@@@@@ >'                   
ERRMSG05 DC    CL60'< DSORG Error !   Not Partitioned File :@@ >'               
*RRMSG06 DC    CL60'< This Dataset is Not Found ... >'                          
*RRMSG07 DC    CL60'< MBBCCHHR:M B B C C H H R  >'                              
*RRMSG10 DC    CL60'< SRCH :'                                                   
*RRMSG11 DC    CL60'< BLOCK : @@@@ / @@@@ = @@@@@@@@@@@@@@@@@@ >'               
*RRMSG12 DC    CL60'< Allocation Space Compute Error  RC:@@@@@@@@ >'            
ERRMSG13 DC    CL60'< Control Table Getmain Faile .. : @@@@@@@@ >'              
ERRMSG14 DC    CL60'< TTR:@@@@@@ = MBBCCHHR:@@@@@@@@ @@@@@@@@ >'                
*                   |....+....1....+....2....+....3....+....4....+....5         
*              ....+....6....+....7....+....8                                   
ERRMSG15 DC    CL75'Directory Table Space to Large . RC:@@@@@@@@ Length*        
               :@@@@@@@@'                                                       
ERRMSG16 DC    CL75'Dataset Now Recovering of Other User .  ENQ RC:@@@@*        
               @@@@'                                                            
*RRMSG17 DC    CL75'Read Buffer Space Getmain False. RC:@@@@@@@@ Length*        
               :@@@@@@@@'                                                       
*RRMSG99 DC    CL60'< TTR:@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ >'           
*RRMSG99 DC    CL60'< GETMAIN SPACE IS:@@@@@@@@ >'                              
*SG001   DC    CL60'< Select ---- members . >'                                  
*SG002   DC    CL60'<< Dataset Vioration Reading ...  Wait a Few Minuts*        
               .. >>'                                                           
*SG003   DC    CL60'<< Member ( @@@@@@@@ ) restored rc_@@@@@@@@ >>'             
*                   |....+....1....+....2....+....3....+....4....+....5         
*SG004   DC    CL70'>> RV001 : @RV ; @@@@@@ < @@/@@/@@ @@:@@ > ; Good M*        
               orning !! '                                                      
*SG005   DC    CL60'>> RV002 :     Parameter Area GetMain OK .'                 
*SG006   DC    CL60'>> RV001 : @RV Initialize Start ...'                        
*SG007   DC    CL60'>> RV001 : @RV Initialize Start ...'                        
*SG999   DC    CL80'>> RV001 : '                                                
*SG000   DC    CL256' '                                                         
*-------------------------------------------------------------------            
MSGLAST  DS    0XL80                                                            
         DC    XL1'05',CL79'   ** END OF LIST **'                               
*-------------------------------------------------------------------            
         DS    0D                                                               
BROWSE_STOW_ERROR DS 0X                                                         
         DC    F'04',F'0000',CL8'REVA001'                                       
BROWSE_STOW_ERROR_LENGTH EQU *-BROWSE_STOW_ERROR                                
         DC    F'12',F'0000',CL8'REVA002'                                       
         DC    F'16',F'0001',CL8'REVA003'                                       
         DC    F'16',F'0002',CL8'REVA004'                                       
         DC    F'16',F'0004',CL8'REVA005'                                       
         DC    F'16',F'1847',CL8'REVA006'                                       
         DC    F'16',F'2871',CL8'REVA007'                                       
         DC    F'16',F'3383',CL8'REVA009'                                       
         DC    F'16',F'3639',CL8'REVA010'                                       
         DC    F'20',F'0000',CL8'REVA011'                                       
         DC    F'24',F'0000',CL8'REVA012'                                       
         DC    F'28',F'0000',CL8'REVA013'                                       
         DC    F'32',F'0000',CL8'REVA014'                                       
         DC    F'36',F'0000',CL8'REVA015'                                       
         DC    F'40',F'0000',CL8'REVA016'                                       
         DC    F'44',F'0000',CL8'REVA017'                                       
         DC    F'48',F'0004',CL8'REVA018'                                       
         DC    F'48',F'0016',CL8'REVA019'                                       
         DC    F'00',F'0000',CL8'REVA999'  End of Table                         
*-------------------------------------------------------------------            
         COPY RV1#COMM                                                          
*-------------------------------------------------------------------            
         COPY  RV1#ETOP                                                         
         COPY  RV1#ISPC                                                         
*-------------------------------------------------------------------            
         DS    0D                                                               
         LTORG                                                                  
         PRINT GEN                                                              
         RV1#ISPV SECTTYP=CSECT                                                 
         PRINT NOGEN                                                            
         COPY  RV1#ALCD                                                         
*-------------------------------------------------------------------            
         COPY RV1#DTH                                                           
*-------------------------------------------------------------------            
         RV1#DTE                                                                
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
JFCBSECT DSECT                                                                  
         IEFJFCBN LIST=YES                                                      
         IEFUCBOB LIST=YES                                                      
         DCBD  DSORG=PO,DEVD=DA                                                 
         CVT   DSECT=YES,LIST=YES                                               
DSCBSEC1 DSECT                                                                  
         IECSDSL1 (1)                                                           
* --- Dataset Configration Dsect ---                                            
         PRINT GEN                                                              
*        COPY  @RV#06DC                                                         
* --- @RV Copy Section ---                                                      
*        COPY  @RV#080X                                                         
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   @RV#090                                                          
