         START                                                                  
* -----------------------------------------------------------------             
         DC   C'<< Revive ! >> ('                                               
         COPY  RV1#HDR                                                          
         PRINT   GEN                                                            
*-------------------------------------------------------------------            
* --- 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                    
*===================================================================            
         CALL  ISPLINK,(VGET,ZPREFIXN,ASIS),VL  Get TSO Prefix                  
         MVC   RVPREFIX,ZPREFIX                                                 
         CALL  ISPLINK,(VGET,REVTRCN,ASIS),VL  Get Trace option                 
         CLC   REVTRC,=CL3'ON'                                                  
         BNE   @PQ                                                              
*+++     OPEN  (TRCF,(OUTPUT))                                                  
*                                                                               
*        CALL  RV1BTH,(SAVEAREA,WKMES2,72)                                      
*        TPUT  WKMES2,L'WKMES2                                                  
*                                                                               
*+++     PUT   TRCF,TRCHDR                                                      
*-------------------------------------------------------------------            
         LA    R01,REVIVED                                                      
         RV1#TRCC BASE=3,COMM=1                                                 
*-------------------------------------------------------------------            
@PQ      EQU   *                                                                
*===================================================================            
         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                                                             
         BAL   R12,@IDSALOC                call Input Dataset Alloc             
         LTR   R15,R15                     if Allocation Error                  
         BNZ   @SE                           goto @SE                           
         MVC   PDSFD+X'28'(8),RV1DDN     Directory Read DD                      
         OPEN  (PDSFD)                   Open Directory and Data Read           
         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)                   Close Directory                        
*-------------------------------------------------------------------            
         MVC   RV1PRC,=CL3'USE'                                                 
         MVI   RV1EXTC,X'01'                                                    
         BAL   R12,@POPSCR               Popup Panel Show                       
*-------------------------------------------------------------------            
         LA    R01,DFTLAST               RV1#FMTB Area Getmain                  
         MH    R01,FMTTBLN                                                      
*++++    L     R01,=F'99999999'                                                 
         ST    R01,WK#F                                                         
         GETMAIN RC,LV=(R01)                                                    
         LTR   R15,R15                   If not Error                           
         BZ    @SE_READDA_SKP00            goto @SE_READDA_SKP00                
         BAL   R14,GETMAIN_ERROR                                                
         B     @SE_X                                                            
@SE_READDA_SKP00 EQU *                                                          
         ST    R01,FMTTBLA               Store RV1FMTB Address                  
         XC    FMTTBLP,FMTTBLP           Clear Max Table Entry                  
* ------ REVTRC --------                                                        
*        TPUT  =CL20'RV1#FMTB',20                                               
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT005,RV1#FMTBX,FMTTBLA,WK#F),VL                     
* ------ REVTRC --------                                                        
*                                                                               
         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           if no-record ?                         
         CALL  ISPLINK,(SETMSG,REV018),VL                                       
         B     @SE_FREE                                                         
@SE_READDA_SKP2 EQU *                                                           
*-------------------------------------------------------------------            
*+       L     R07,RV1TBSPA                                                     
@SE_DIRFREE_LOP1 EQU *                                                          
*+       TM    11(R07),X'01'                                                    
*+       BO    @SE_DIRFREE_LOP1N                                                
*+       TPUT  (R07),8                                                          
@SE_DIRFREE_LOP1N EQU *                                                         
*+       LA    R07,12(R07)                                                      
*+       CL    R07,RV1TBSPP                                                     
*+       BNL   @SE_DIRFREE_LOP1X                                                
*+       B     @SE_DIRFREE_LOP1                                                 
@SE_DIRFREE_LOP1X EQU *                                                         
*        TPUT  =CL20'*MSG1*',20                                                 
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1TBSPX,RV1TBSPA,RV1TBSPL),VL                 
*        TPUT  =CL20'*MSG2*',20                                                 
         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   REVTRC,=CL3'ON'                                                  
*+       BNE   @TRC_X                                                           
*+       CLOSE (TRCF)                                                           
*+       TPUT  =CL20'TRC OFF',20                                                
*+       MVC   REVTRC,=CL3'OFF'                                                 
*+RC_X   EQU   *                                                                
*===================================================================            
         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                                                      
* --- RV1TRC ---                                                                
         LA    R01,DFTLAST               RV1#FMTB Area Freemain                 
         MH    R01,FMTTBLN                                                      
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1#FMTBX,FMTTBLA,WK#F),VL                     
* --- RV1TRC ---                                                                
         LA    R01,DFTLAST               RV1#FMTB Area Freemain                 
         MH    R01,FMTTBLN                                                      
         L     R02,FMTTBLA                                                      
         FREEMAIN RC,LV=(R01),A=(R02)                                           
         B     @SE                                                              
*-------------------------------------------------------------------            
@SE_CLOSE EQU   *                                                               
         CLOSE (PDSFD)                                                          
@SE_FREE EQU   *                                                                
         BAL   R12,@IDSFREE                call Input Dataset Alloc             
@SE_X    EQU   *                                                                
         B     @SE                                                              
@BYE     EQU   *                                                                
*        TPUT  =CL20'BYE',20                                                    
         CLC   REVTRC,=CL3'ON'                                                  
         BNE   TRCF_X                                                           
*        CALL  RV1BTH,(TRCF,WKTRCF,TRCFL)                                       
*        TPUT  WKTRCF,TRCFL*2                                                   
*+++     CLOSE (TRCF)                                                           
TRCF_X   EQU   *                                                                
*        TPUT  =CL20'BYE_X',20                                                  
*        CALL  RV1BTH,(SAVEAREA,WKMES2,72)                                      
*        TPUT  WKMES2,L'WKMES2                                                  
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
*-------------------------------------------------------------------            
*-------- Initialization -------------------------------------------            
*-------------------------------------------------------------------            
MVRV1DSN MVC   RV1DSN(0),2(R01)          Copy Arg to RV1DSN Area                
@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                                                            
         EX    R02,MVRV1DSN                                                     
*        TPUT  RV1DSN,44                                                        
@I_SKP1  EQU   *                                                                
         LA    R01,PDSFD                 Save PDSF DCB Address                  
         ST    R01,A#PDSF                 ( PDS Data )                          
*+       LA    R01,TRCF                  Save PDSF DCB Address                  
*+       ST    R01,A#TRCF                 ( 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   *                                                                
         MVC   VDDEPTH,VDEPTH                                                   
         MVC   VDWIDTH,VWIDTH                                                   
         L     R01,VDDEPTH                                                      
*        BCTR  R01,0                                                            
         MH    R01,VDWIDTH+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                   
* ------ REVTRC --------                                                        
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT005,RV1DAREAX,RV1DAREAA,RV1DAREAL),VL              
* ------ REVTRC --------                                                        
         L     R01,RV1DAREAA            Load List Panel Area                    
         CALL  ISPLINK,(VDEFINE,RV1DAREAN,(R01),RV1DAREAT,RV1DAREAL),VL         
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------- Show Entry Panel -----------------------------------------            
*-------------------------------------------------------------------            
         DS    0F                                                               
MVRV1SSTRR MVC   RV1SSTRR(0),0(R15)                                             
@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)                                               
         EX    R02,MVRV1SSTRR                                                   
         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    R08,R01                                                          
* ------ REVTRC --------                                                        
         L     R01,=A(RV1ALCDL)                                                 
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT005,RV1ALCDX,@ID_GETMA,WK#F),VL                    
* ------ REVTRC --------                                                        
*--- Space Clear Dynamic Allocation Work Area ----------------------            
         LR    R14,R08                                                          
         L     R09,=X'00000000'                                                 
*                     --                 pattern                                
         L     R15,=A(RV1ALCDL)                                                 
         BCTR  R15,0                                                            
         LAE   R15,0(R09,R15)                                                   
         MVCL  R14,R08                                                          
*         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                                                        
*XCRV1ALCD XC   0(0,R01),0(R01)           Null Clear                            
*@ID_CLR1X EQU  *                                                               
**        STC   R02,*+5                                                         
**        XC    0(0,R01),0(R01)           Null Clear                            
*         EX    R02,XCRV1ALCD                                                   
*--- Setup Dynamic Allocation --------------------------------------            
         USING RV1ALCD,R08                                                      
         CLI   RV1DISP,C'O'              If Not Exclusive Enq                   
         BNE   @ID_SKP1                                                         
         MVC   DA#DISP(3),=CL3'OLD'                                             
         B     @ID_SKP2                                                         
MVDA#ERR MVC   0(0,R10),2(R02)                                                  
@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  R08                                                              
*--- 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                                                          
* ------ REVTRC --------                                                        
         ST    R01,WK#F                                                         
         L     R01,=A(L'DA#ERR)                                                 
         ST    R01,WK#F2                                                        
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT005,DA#ERRX,WK#F,WK#F2),VL                         
* ------ REVTRC --------                                                        
         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)                                                  
         EX    R15,MVDA#ERR                                                     
*                                                                               
         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                                       
*                                                                               
* --- RV1TRC ---                                                                
         L     R01,=A(RV1ALCDL)                                                 
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1ALCDX,@ID_GETMA,WK#F),VL                    
* --- RV1TRC ---                                                                
         L     R01,@ID_GETMA                                                    
         L     R02,=A(RV1ALCDL)                                                 
         FREEMAIN RC,LV=(R02),A=(R01)    Free Dynamic Alloc Area                
* --- RV1TRC ---                                                                
         L     R01,=A(L'DA#ERR)                                                 
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,DA#ERRX,DAMSGA,WK#F),VL                        
* --- RV1TRC ---                                                                
         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                                       
*                                                                               
* --- RV1TRC ---                                                                
         L     R01,=A(RV1ALCDL)                                                 
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1ALCDX,@ID_GETMA,WK#F),VL                    
* --- RV1TRC ---                                                                
         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                                                              
*                                                                               
* --- RV1TRC ---                                                                
         L     R01,=A(RV1ALCDL)                                                 
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1ALCDX,@ID_GETMA,WK#F),VL                    
* --- RV1TRC ---                                                                
         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     R08,=A(RV1ALCDL)                                                 
         GETMAIN RC,LV=(R08)            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                           
* ------ REVTRC --------                                                        
         L     R01,=A(RV1ALCDL)                                                 
         ST    R01,WK#F2                                                        
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT005,RV1ALCDX,@IDF_GETMA,WK#F2),VL                  
* ------ REVTRC --------                                                        
         L     R08,@IDF_GETMA                                                   
         LR    R14,R08                                                          
         L     R09,=X'00000000'                                                 
*                     --                 pattern                                
         L     R15,=A(RV1ALCDL)                                                 
         BCTR  R15,0                                                            
         LAE   R15,0(R09,R15)                                                   
         MVCL  R14,R08                                                          
*+++                                                                            
*         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                                                       
*XCRV1ALCD2 XC    0(0,R15),0(R15)           Null Clear                          
*@IDS_CLR1X EQU  *                                                              
**        STC   R02,*+5                                                         
**        XC    0(0,R15),0(R15)           Null Clear                            
*         EX    R02,XCRV1ALCD2                                                  
*+++                                                                            
         USING RV1ALCD,R08                                                      
         MVC   DA#DISP,=CL3'FRE'         File Free                              
         MVC   DA#RETDD,RV1DDN           Save Input DD                          
         DROP  R08                                                              
         LR    R01,R08                   set parm                               
         CALL  RV1DALC                   Call Dynamic Alloc Routine             
*                                                                               
         LTR   R15,R15                                                          
         BZ    @IDF_SKP3                                                        
         TPUT  =CL60'*** Free Error ***',60                                     
* --- RV1TRC ---                                                                
         L     R01,=A(RV1ALCDL)                                                 
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1ALCDX,@IDF_GETMA,WK#F),VL                   
* --- RV1TRC ---                                                                
         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  *                                                                
*                                                                               
* --- RV1TRC ---                                                                
         L     R01,=A(RV1ALCDL)                                                 
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1ALCDX,@IDF_GETMA,WK#F),VL                   
* --- RV1TRC ---                                                                
         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                                                         
*                                                                               
         LA    R08,RV1DSIS                                                      
         LR    R14,R08                                                          
         L     R09,=X'00000000'                                                 
*                     --                 pattern                                
         LA    R15,RV1DSIDL                                                     
         BCTR  R15,0                                                            
         LAE   R15,0(R09,R15)                                                   
         MVCL  R14,R08                                                          
*+++                                                                            
*         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                                                        
*XCRV1DSID XC    0(0,R15),0(R15)    Null Clear                                  
*@GD_LOP1X EQU  *                                                               
**        STC   R02,*+5                                                         
**        XC    0(0,R15),0(R15)    Null Clear                                   
*         EX    R02,XCRV1DSID                                                   
*+++                                                                            
*                                                                               
         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'12'                Table Length                           
*                                          8 Byte : Member Name                 
*                                          3 Byte : TTR                         
*                                          1 Byte : Flag                        
*                                          x'01'  : Member Processed            
         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                          
* ------ REVTRC --------                                                        
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT005,RV1TBSPX,RV1TBSPA,RV1TBSPL),VL                 
* ------ REVTRC --------                                                        
*-------- 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                      
* ------ REVTRC --------                                                        
         LA    R01,256                                                          
         ST    R01,WK#F                                                         
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT005,RV1DIRBX,RV1DIRBA,WK#F),VL                     
* ------ REVTRC --------                                                        
*-------- Directory Read -------------------------------------------            
         XR    R07,R07                   Clear Member Counter                   
         XC    O#DBLK(L'O#DBLK),O#DBLK   Clear Directory Block                  
@RD_READ EQU   *                                                                
*        TPUT  =CL20'READ ...',20                                               
         L     R02,RV1DIRBA                                                     
         READ  DECB01,SF,PDSFD,(R02),'S' Read Directory                         
         CHECK DECB01                                                           
*        TPUT  =CL20'READ X..',20                                               
*                                                                               
         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               
         MVI   11(R01),X'00'             Clear Flag                             
         LA    R01,12(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               
         L     R02,RV1TBSPP                                                     
         LA    R02,12(R02)                                                      
         CLR   R01,R02                   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   *                                                                
* ------ REVTRC --------                                                        
         LA    R01,256                                                          
         L     R02,RV1DIRBA                                                     
         ST    R01,WK#F                                                         
         ST    R02,WK#F2                                                        
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,RV1DIRBX,WK#F2,WK#F),VL                        
* ------ REVTRC --------                                                        
         LA    R01,256                                                          
         L     R02,RV1DIRBA                                                     
         FREEMAIN RC,LV=(R01),A=(R02)           FreeMain Direct Table           
*        TPUT  =CL20'END ...',20                                                
*-------- 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                                                              
MVDTTLCOLS MVC   0(0,R09),0(R01)                                                
PD#SKP0  EQU   *                                                                
*        TPUT  =CL20'DISPLAY',20                                                
*-------------------------------------------------------------------            
* Display Work Area Space Clear.                                                
*-------------------------------------------------------------------            
         L     R08,RV1DAREAA                                                    
         LR    R14,R08                                                          
         L     R09,=X'40000000'                                                 
*                     --                 pattern                                
         L     R15,RV1DAREAL                                                    
         BCTR  R15,0                                                            
         LAE   R15,0(R09,R15)                                                   
         MVCL  R14,R08                                                          
*        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                                                           
*MVRV1DAREA MVC   1(0,R01),0(R01)                                               
*PD#CLSX EQU   *                                                                
**       STC   R02,*+5                                                          
**       MVC   1(0,R01),0(R01)                                                  
*        EX    R02,MVRV1DAREA                                                   
*-------------------------------------------------------------------            
* Search Target Table Row.                                                      
*   R09(DTPOSIT) : Target Row.                                                  
*   R08          : Processing Table Address                                     
* Row Re-Positioning.                                                           
*   DTPOSIT > DTLASTE : DTLASTE - VDDEPTH -1 -> DTPOSIT                         
*   DTPOSIT < 1       : 1                    -> DTPOSIT                         
*-------------------------------------------------------------------            
*        L     R09,DTPOSIT                                                      
*        CL    R09,DTLASTE                                                      
*        BNH   PD#POS1                                                          
*        L     R09,DTLASTE                                                      
*        LA    R09,3(R09)                                                       
*        CL    R09,VDDEPTH                                                      
*        BNH   PD#POS0                                                          
*        S     R09,VDDEPTH                                                      
**       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,(VDDEPTH,MSG999+30,4)                                     
*        CALL  RV1BTH,(DTLASTE,MSG999+40,4)                                     
*        TPUT  MSG999,80                                                        
*DEBUG*                                                                         
* ---------------------------------------------------------------               
* Setup Column Line.                                                            
* ---------------------------------------------------------------               
         BAL   R14,DTTL_MAKE                                                    
* ---------------------------------------------------------------               
* === debug =====================================================               
*        TPUT  =CL20'START',20                                                  
         L     R08,DTFIRST                                                      
         USING DTHEADER,R08                                                     
DBG_LOP1 EQU   *                                                                
         CALL  RV1BTH,((R08),WKMES+10,16)                                       
*        TPUT  WKMES,80                                                         
         L     R08,DTHNEXT                                                      
         LTR   R08,R08                                                          
         BZ    DBG_LOP1X                                                        
         B     DBG_LOP1                                                         
         DROP  R08                                                              
DBG_LOP1X EQU   *                                                               
*        TPUT  =CL20'END  ',20                                                  
* === debug =====================================================               
         L     R09,DTPOSIT                                                      
         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                                                      
         L     R15,=A(DTELAST)                                                  
         STH   R15,WK#H                                                         
         MH    R09,WK#H                                                         
         LA    R09,DTHL(R09,R08)                                                
* ------ REVTRC --------                                                        
         L     R01,DTHPOSF                                                      
         ST    R01,WK#F                                                         
         L     R01,DTHPREV                                                      
         ST    R01,WK#F2                                                        
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT007,SCRLCHK,DTPOSIT,WK#F,WK#F2),VL                 
* ------ REVTRC --------                                                        
         USING DTENTRY,R09                                                      
* ---------------------------------------------------------------               
* Write Rows Calc.                                                              
*   Tbl-Rows  Current-Pos       Win-Depth     Write-Row                         
*   DTLASTE - DTPOSIT + 1   <   VDDEPTH  ->   DTPOSIT                           
*   DTLASTE - DTPOSIT + 1   >   VDDEPTH  ->   VDDEPTH                           
*   DTLASTE - DTPOSIT + 1   =   VDDEPTH  ->   VDDEPTH ( or DTPOSIT )            
* ---------------------------------------------------------------               
         L     R07,DTLASTE                                                      
         S     R07,DTPOSIT                                                      
         LA    R07,1(R07)                                                       
         CL    R07,VDDEPTH                                                      
         BL    PD#ROWC                                                          
         L     R07,VDDEPTH               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                                                
*                                                                               
         TM    PSCRFLAG,X'80'                                                   
         BNO   PD#SKP11                                                         
*                                                                               
         TM    DTERFM,X'80'              If Not Recfm=V ?                       
         BO    PD#SKP12                                                         
         MVI   19(R10),C'V'              Recfm:V                                
         LH    R01,DTELRL                 Lrecl                                 
         CVD   R01,PK_AREA                                                      
         MVC   EDWORK,EDMASK                                                    
         ED    EDWORK,PK_AREA                                                   
         MVC   21(5,R10),EDWORK+11                                              
         B     PD#SKP14                                                         
PD#SKP12 EQU   *                                                                
         TM    DTERFM,X'10'              If Not Recfm=F ?                       
         BO    PD#SKP13                                                         
         MVI   19(R10),C'F'              Recfm:F                                
         LH    R01,DTERLNG                Lrecl                                 
         CVD   R01,PK_AREA                                                      
         MVC   EDWORK,EDMASK                                                    
         ED    EDWORK,PK_AREA                                                   
         MVC   21(5,R10),EDWORK+11                                              
         B     PD#SKP14                                                         
PD#SKP13 EQU   *                                                                
         MVI   19(R10),C'U'                                                     
         MVC   21(5,R10),=CL5'    ?'                                            
PD#SKP14 EQU   *                                                                
         LH    R01,DTEBSZ                BlockSize                              
         CVD   R01,PK_AREA                                                      
         MVC   EDWORK,EDMASK                                                    
         ED    EDWORK,PK_AREA                                                   
         MVC   27(5,R10),EDWORK+11                                              
         L     R01,DTERECD               Records                                
         CVD   R01,PK_AREA                                                      
         MVC   EDWORK,EDMASK                                                    
         ED    EDWORK,PK_AREA                                                   
         MVC   33(5,R10),EDWORK+11                                              
         MVC   39(40,R10),DTEDATA                                               
         B     PD#SKP11X                                                        
*                                                                               
PD#SKP11 EQU   *                                                                
         MVC   19(60,R10),DTEDATA                                               
PD#SKP11X EQU   *                                                               
*                                                                               
         L     R01,VDWIDTH                                                      
         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,VDWIDTH                                                      
         LA    R01,0(R10,R01)                                                   
         CL    R01,RV1DAREAL                                                    
         BNH   PD#SKP2                                                          
         MVC   0(L'MSGLAST,R10),MSGLAST                                         
PD#SKP2  EQU   *                                                                
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT003,PANELLST),VL                                   
         CALL  ISPLINK,(DISPLAY,PANELLST),VL                                    
         ST    R15,DISPLAYRC                                                    
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT004,PANELLST),VL                                   
*-------------------------------------------------------------------            
*        CALL  ISPLINK,(VGET,RV1DAREAN,ASIS),VL                                 
*        L     R01,RV1DAREAA                                                    
*        TPUT  (R01),80                                                         
         BR    R12                                                              
DISPLAYRC DS   F                                                                
*-------------------------------------------------------------------            
* Make Title line                                                               
*-------------------------------------------------------------------            
DTTL_MAKE EQU  *                                                                
         MVI   DTTLCOLS,C'('                                                    
         LA    R09,DTTLCOLS+1                                                   
*                                                                               
         L     R01,DTPOSIT                                                      
         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'5'                                                        
         BH    PD#SKP011                                                        
         LA    R01,EDWORK+L'EDWORK                                              
         SR    R01,R00                                                          
*        STC   R15,*+5                                                          
*        MVC   0(0,R09),0(R01)                                                  
         EX    R15,MVDTTLCOLS                                                   
         LA    R09,0(R09,R15)                                                   
         B     PD#SKP012                                                        
PD#SKP011 EQU  *                                                                
         MVC   0(5,R09),=CL5'*****'                                             
         LA    R09,4(R09)                                                       
PD#SKP012 EQU  *                                                                
*                                                                               
         MVI   0(R09),C','                                                      
         LA    R09,1(R09)                                                       
*                                                                               
         L     R01,DTLASTE                                                      
         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'5'                                                        
         BH    PD#SKP013                                                        
         LA    R01,EDWORK+L'EDWORK                                              
         SR    R01,R00                                                          
*        STC   R15,*+5                                                          
*        MVC   0(0,R09),0(R01)                                                  
         EX    R15,MVDTTLCOLS                                                   
         LA    R09,0(R09,R15)                                                   
         B     PD#SKP014                                                        
PD#SKP013 EQU  *                                                                
         MVC   0(5,R09),=CL5'*****'                                             
         LA    R09,4(R09)                                                       
PD#SKP014 EQU  *                                                                
         MVI   0(R09),C')'                                                      
         LA    R01,DTTLCOLS                                                     
         SR    R09,R01                                                          
*                                                                               
         TM    PSCRFLAG,X'80'                                                   
         BNO   PD#SKP01                                                         
         MVC   RV1DTTL(80),DTTL2         Set Title                              
         B     PD#SKP02                                                         
MVRV1DTTL MVC   0(0,R01),DTTLCOLS                                               
PD#SKP01 EQU   *                                                                
         MVC   RV1DTTL(80),DTTL1         Set Title                              
PD#SKP02 EQU   *                                                                
         LA    R01,RV1DTTL+L'RV1DTTL-2                                          
         SR    R01,R09                                                          
*        STC   R09,*+5                                                          
*        MVC   0(0,R01),DTTLCOLS                                                
         EX    R09,MVRV1DTTL                                                    
         BR    R14                                                              
*                                                                               
*-------------------------------------------------------------------            
* List Panel Scroll.                                                            
*-------------------------------------------------------------------            
PSCROLL  EQU   *                                                                
         CALL  ISPLINK,(VGET,RV1SCROLL,ASIS),VL  Get Scroll Variable            
         CLC   ZVERB(8),=CL8'LEFT    '                                          
         BE    PSCR#LF                                                          
         CLC   ZVERB(8),=CL8'RIGHT   '                                          
         BE    PSCR#RI                                                          
         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,2(R09)                                                       
         CL    R09,ZSCROLLN                                                     
         BNH   PSCR#DW0                                                         
         S     R09,ZSCROLLN                                                     
         B     PSCROLLX                                                         
PSCR#DW0 EQU   *                                                                
         LA    R09,1                                                            
         B     PSCROLLX                                                         
PSCR#DW1 EQU   *                                                                
*        Down                                                                   
         L     R09,DTPOSIT                                                      
         A     R09,ZSCROLLN                                                     
         CL    R09,DTLASTE                                                      
         BNH   PSCROLLX                                                         
         L     R09,DTLASTE                                                      
*        LA    R09,2(R09)                                                       
*        CL    R09,ZSCROLLN                                                     
*        BNH   PSCR#DW0                                                         
*        S     R09,ZSCROLLN                                                     
*        B     PSCROLLX                                                         
         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                                                            
         B     PSCROLLX                                                         
PSCR#LF  EQU   *                                                                
         OI    PSCRFLAG,X'80'            Left Screen                            
         B     PSCROLLQ                                                         
PSCR#RI  EQU   *                                                                
         NI    PSCRFLAG,X'7F'            Right Screen                           
         B     PSCROLLQ                                                         
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)                                                 
* ------ REVTRC --------                                                        
         ST    R08,WK#F                                                         
         ST    R09,WK#F2                                                        
         LA    R01,REVIVED                                                      
         RV1#TRCG ((R01),REVT006,DTX,WK#F,WK#F2),VL                             
* ------ REVTRC --------                                                        
         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.'                          
*-------------------------------------------------------------------            
         STM   R00,R15,GE_REGS                                                  
         CALL  ISPLINK,(SETMSG,REV010),VL                                       
         LM    R00,R15,GE_REGS                                                  
         BR    R14                                                              
REV010   DC   CL8'REV010'                                                       
GE_REGS  DS   18F                                                               
*-------------------------------------------------------------------            
* List Panel Command Proecss.                                                   
*-------------------------------------------------------------------            
PCMDPROC EQU   *                                                                
         L     R10,RV1DAREAA                                                    
         L     R09,VDDEPTH                                                      
         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                                                     
         CALL  RV1EXTR,(REVIVED,CMDPROCA)                                       
         B     PC#CMDPROCX                                                      
PC#CMDPROC3 EQU *                                                               
         CLI   PC@CMD,C'S'                                                      
         BNE   PC#CMDPROC4                                                      
*        PRINT GEN                                                              
*        CALL  RV1SHOW,(REVIVED,CMDPROCA)                                       
*        PRINT NOGEN                                                            
         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,VDWIDTH                                                      
         LA    R10,0(R10,R01)                                                   
         BCT   R09,PC#LOP1                                                      
         XR    R15,R15                                                          
         BR    R12                                                              
*-------------------------------------------------------------------            
*--------- 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   *                                                                
         CALL  RV1EXTR,(REVIVED,CMDPROCA)                                       
         BR    R12                                                              
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
@DC_REGS DS    18F                                                              
MVDSNP   MVC   0(0,R08),RVPREFIX         Copy TSO Prefix                        
MVDSNP2  MVC   0(0,R08),0(R07)           Coopy Dataset Name                     
MVDSNP3  MVC   0(0,R08),1(R07)           Copy DSN                               
@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                        
         LA    R01,RVPREFIX              R01 <- TSO Prefix Address              
         LA    R02,7                     R02 <- Maximam Length                  
@DC_LOP1 EQU   *                                                                
         CLI   0(R01),C' '               If End ?                               
         BE    @DC_LOP1X                   goto @DC_LOP1X                       
         LA    R01,1(R01)                Shift                                  
         BCT   R02,@DC_LOP1              Loop @DC_LOP1                          
@DC_LOP1X EQU  *                                                                
         LA    R15,RVPREFIX              Calculate Prefix Length                
         SR    R01,R15                                                          
         EX    R01,MVDSNP                                                       
         LA    R08,0(R08,R01)            R08 <- DSN Address + Prefix            
         MVI   0(R08),C'.'               Add Period                             
         LA    R08,1(R08)                Plus 1 ( for Period )                  
         LR    R01,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                     
         EX    R01,MVDSNP2                                                      
         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                               
         EX    R01,MVDSNP3                                                      
@DC_SKP2 EQU   *                                                                
         LM    R00,R14,@DC_REGS                                                 
         BR    R14                                                              
*-------------------------------------------------------------------            
@CRREGS  DS    18F                                                              
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
*-------------------------------------------------------------------            
*-------- 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     R08,RV1TBSPA                                                     
         FREEMAIN RC,LV=(R02),A=(R08)           FreeMain Direct Table           
         LA    R02,256                                                          
         L     R08,RV1DIRBA                                                     
         FREEMAIN RC,LV=(R02),A=(R08)           FreeMain Direct Table           
         LA    R15,16                                                           
         BR    R12                                                              
*+       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 --------------------------------            
*-------------------------------------------------------------------            
PDSFD    DCB   DSORG=PS,MACRF=(RP),DDNAME=@@@@,BLKSIZE=256,            *        
               SYNAD=@RD_EXIT,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                                                    
TRCF     DCB   DSORG=PS,MACRF=(PM),DDNAME=REVTRC,                      *        
               RECFM=F,LRECL=80,BLKSIZE=80                                      
TRCFL    EQU   *-TRCF                                                           
         ENTRY TRCF                                                             
WKTRCF   DS    (TRCFL*3)C                                                       
*                                                                               
DSCBFMT1 CAMLST SEARCH,DSCB1DSN,DSCB1VOL,DSCB1                                  
DSCB1VOL DS    CL6                                                              
JFCB1    DS    0CL176                    job file control block                 
DSCB1DSN DS    CL44                                                             
DSCB1    DS    CL140                                                            
         DS    0F                                                               
*RITE_TTR DS   XL4                                                              
*                                                                               
WKMES2   DS    CL162                                                            
         DS    0F                                                               
* --- SAVE AREA ---                                                             
SAVEAREA DS    18F                               SAVEAREA                       
* --- Work Area ---                                                             
WK#F     DS    F                                                                
WK#F2    DS    F                                                                
* --- Register Save ( work ) area ---                                           
REGS     DS    18F                               WORK SAVEAREA                  
CMD#REG  DS    18F                               WORK SAVEAREA                  
PC@REGS  DS    18F                       Attribute                              
         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@EXT2'                     ISPF PANEL ( INFO )            
PANELEXTW DC   CL8'REV@EXTW'                     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'                                                      
REV021   DC    CL8'REV021'                                                      
REV990   DC    CL8'REV990'                                                      
REVT003  DC    CL8'REVT003'                                                     
REVT004  DC    CL8'REVT004'                                                     
REVT005  DC    CL8'REVT005'                                                     
REVT006  DC    CL8'REVT006'                                                     
REVT007  DC    CL8'REVT007'                                                     
SCRLCHK  DC    CL8'SCRLCHK'                                                     
RV1#FMTBX DC   CL8'RV1#FMTB'                                                    
RV1DAREAX DC   CL8'RV1DAREA'                                                    
RV1ALCDX  DC   CL8'RV1ALCD'                                                     
DA#ERRX   DC   CL8'DA#ERR'                                                      
RV1TBSPX  DC   CL8'RV1TBSP'                                                     
RV1DIRBX  DC   CL8'RV1DIRB'                                                     
DTX       DC   CL8'DT'                                                          
* ------ REVTRC --------                                                        
M1N      DC    CL8'M1'                                                          
M2N      DC    CL8'M2'                                                          
M3N      DC    CL8'M3'                                                          
M4N      DC    CL8'M4'                                                          
M5N      DC    CL8'M5'                                                          
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                                                                
PSCRFLAG DC    BL1'00000000'                                                    
*                  .                     1:Left 0:Right Screen                  
*                   .                                                           
*                    .                                                          
*                     .                                                         
*                      .                                                        
*                       .                                                       
*                        .                                                      
*                         .                                                     
*                                                                               
         DS    0F                                                               
*--- messages ---                                                               
*                   |....+....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 :@@ >'               
ERRMSG13 DC    CL60'< Control Table Getmain Faile .. : @@@@@@@@ >'              
ERRMSG14 DC    CL60'< TTR:@@@@@@ = MBBCCHHR:@@@@@@@@ @@@@@@@@ >'                
ERRMSG15 DC    CL75'Directory Table Space to Large . RC:@@@@@@@@ Length*        
               :@@@@@@@@'                                                       
ERRMSG16 DC    CL75'Dataset Now Recovering of Other User .  ENQ RC:@@@@*        
               @@@@'                                                            
TRCHDR   DC    CL80'** Revive! Process Trace **'                                
WK#C     DS    CL8                                                              
*-------------------------------------------------------------------            
MSGLAST  DS    0XL80                                                            
         DC    XL1'05',CL79'   ** END OF LIST **'                               
DTTL1    DS    0XL80                                                            
         DC    XL01'90'                                                         
         DC    CL79'  Member   T T R  -- Data ( First 60 Byte ) --'             
DTTL2    DS    0XL80                                                            
         DC    XL01'90'                                                         
         DC    CL79'  Member   T T R  F Lrecl Blksz Recds -- Data ( Fir*        
               st 40 Byte ) --'                                                 
DTTLCOLS DS    CL13                                                             
*-------------------------------------------------------------------            
         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                                                         
*-------------------------------------------------------------------            
         RV1#CMDA SECTTYP=CSECT                                                 
*-------------------------------------------------------------------            
         DS    0D                                                               
         LTORG                                                                  
         PRINT GEN                                                              
*-------------------------------------------------------------------            
         RV1#ISPV SECTTYP=CSECT                                                 
*-------------------------------------------------------------------            
         PRINT NOGEN                                                            
*-------------------------------------------------------------------            
         COPY  RV1#ALCD                                                         
*-------------------------------------------------------------------            
         COPY RV1#DTH                                                           
*-------------------------------------------------------------------            
         RV1#DTE  SECTTYP=DSECT                                                 
*-------------------------------------------------------------------            
         RV1#FMTB SECTTYP=DSECT                                                 
*-------------------------------------------------------------------            
JFCBSECT DSECT                                                                  
         IEFJFCBN LIST=YES                                                      
         IEFUCBOB LIST=YES                                                      
         DCBD  DSORG=PO,DEVD=DA                                                 
         CVT   DSECT=YES,LIST=YES                                               
DSCBSEC1 DSECT                                                                  
         IECSDSL1 (1)                                                           
* --- 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                                                          
