News Stay informed about the latest enterprise technology news and product updates.

Victor Velardez ANZKEYF command

Victor Velardez ANZKEYF command

   
  
Comando ANZKEYF 
/* autor VICTOR VELARDEZ       */
/* e-mail.velardezv@comafi.com.ar */
/* Tucuman- Argentina */

            CMD        PROMPT('Analiza vias de acceso')                     
            PARM       KWD(JRNRCV) TYPE(QUAL) PROMPT('Archivo de +          
                         Base de Datos')                                    
            PARM       KWD(KEYFLD) TYPE(*CHAR) LEN(10) +                    
                         SPCVAL((*ALL)) MIN(1) MAX(10) +                    
                         LISTDSPL(*INT4) PROMPT('Campos Claves a +          
                         buscar')                                           
QUAL:       QUAL       TYPE(*NAME) MIN(1)                                   
            QUAL       TYPE(*CHAR) LEN(10) DFT(*LIBL) +                     
                         PROMPT('Biblioteca')                               
/* ------------------------------------*/

/*CLP - TOL010C . called by anzkeyf command */
            PGM        PARM(&OBJ &KEYFLD)                             
                                                                      
            DCL        VAR(&OBJ) TYPE(*CHAR) LEN(20)                  
            DCL        VAR(&F) TYPE(*CHAR) LEN(10)                    
            DCL        VAR(&L) TYPE(*CHAR) LEN(10)                    
            DCL        VAR(&KEYFLD) TYPE(*CHAR) LEN(100)              
            DCL        VAR(&NBRCURRCD) TYPE(*DEC) LEN(10 0)           
            DCL        VAR(&OBJATR) TYPE(*CHAR) LEN(10)               
            DCLF       FILE(QADSPDBR) RCDFMT(QWHDRDBR)                
                                                                      
            DLTOVR     FILE(*ALL)                                     
            MONMSG     MSGID(CPF0000)                                 
            RCLRSC                                                    
            MONMSG     MSGID(CPF0000)                                 
            DLTF       FILE(QTEMP/DBR)                                
            MONMSG     MSGID(CPF0000)                                 
            DLTF       FILE(QTEMP/FDF)                                
            MONMSG     MSGID(CPF0000)                                 
            DLTF       FILE(QTEMP/FDFP)                               
            MONMSG     MSGID(CPF0000)                                 
            DLTF       FILE(QTEMP/SELEC)                              
            MONMSG     MSGID(CPF0000)                                 
            CHGVAR     VAR(&F) VALUE(%SST(&OBJ 01 10))                
             CHGVAR     VAR(&L) VALUE(%SST(&OBJ 11 10))                         
                                                                                
             IF         COND(&L ?= '*LIBL     ') THEN(DO)                       
             CHKOBJ     OBJ(QSYS/&L) OBJTYPE(*LIB)                              
             MONMSG     MSGID(CPF0000) EXEC(DO)                                 
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No se +            
                          ha encontrado la biblioteca ' || &L) +                
                          MSGTYPE(*DIAG)                                        
             GOTO       CMDLBL(END_PGM)                                         
             ENDDO                                                              
             ENDDO                                                              
                                                                                
             CHKOBJ     OBJ(&L/&F) OBJTYPE(*FILE)                               
             MONMSG     MSGID(CPF0000) EXEC(DO)                                 
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No se +            
                          ha encontrado el archivo ' || &F |< ' +               
                          de Biblioteca ' || &L) MSGTYPE(*DIAG)                 
             GOTO       CMDLBL(END_PGM)                                         
             ENDDO                                                              
                                                                                
             RTVOBJD    OBJ(&L/&F) OBJTYPE(*FILE) OBJATR(&OBJATR)               
                                                                                
             IF         COND(&OBJATR ?= 'PF        ') THEN(DO)                  
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('El +               
                          Objeto ' || &F |< ' de la Biblioteca ' +          
                          || &L |< ', no es un archivo fisico') +           
                          MSGTYPE(*DIAG)                                    
             GOTO       CMDLBL(END_PGM)                                     
             ENDDO                                                          
             DSPDBR     FILE(&L/&F) OUTPUT(*OUTFILE) OUTFILE(QTEMP/DBR)     
             MONMSG     MSGID(CPF0000) EXEC(DO)                             
                CPYF FROMFILE(QSYS/QADSPDBR) TOFILE(QTEMP/DBR) +            
                     MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)              
                     MONMSG CPF0000                                         
             ENDDO                                                          
                                                                            
             RTVMBRD    FILE(QTEMP/DBR) NBRCURRCD(&NBRCURRCD)               
                                                                            
             IF         COND(&NBRCURRCD = 0) THEN(DO)                       
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('El +           
                          Objeto ' || &F |< ' de la Biblioteca ' || +       
                          &L |< ', no tiene vias de acceso +                
                          asociadas') MSGTYPE(*DIAG)                        
             GOTO       CMDLBL(END_PGM)                                     
             ENDDO                                                          
                                                                            
             DSPFD      FILE(&L/&F) TYPE(*ACCPTH) OUTPUT(*OUTFILE) +        
                          OUTFILE(QTEMP/FDFP)                               
             MONMSG     MSGID(CPF0000) EXEC(DO )                              
             CPYF       FROMFILE(QSYS/QAFDACCP) TOFILE(QTEMP/FDFP) +          
                          MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)           
                     MONMSG CPF0000                                           
             ENDDO                                                            
             OVRDBF     FILE(QADSPDBR) TOFILE(QTEMP/DBR)                      
RCVF:                                                                         
             RCVF       DEV(*FILE) RCDFMT(*FILE)                              
             MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(CONTINUE))            
             DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*ACCPTH) +                 
                          OUTPUT(*OUTFILE) FILEATR(*LF) +                     
                          OUTFILE(QTEMP/FDF) OUTMBR(*FIRST *ADD)              
             MONMSG     MSGID(CPF0000) EXEC(DO )                              
             CPYF       FROMFILE(QSYS/QAFDACCP) TOFILE(QTEMP/FDF) +           
                          MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)           
                     MONMSG CPF0000                                           
             ENDDO                                                            
             DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*SELECT) +                 
                          OUTPUT(*OUTFILE)  +                                 
                          OUTFILE(QTEMP/SELEC) OUTMBR(*FIRST *ADD)            
             MONMSG     MSGID(CPF0000)  EXEC(DO)                              
             CPYF       FROMFILE(QSYS/QAFDSELO) TOFILE(QTEMP/SELEC) +         
                          MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)           
                     MONMSG CPF0000                                           
             ENDDO                                                    
             GOTO       CMDLBL(RCVF)                                  
                                                                      
CONTINUE:                                                             
             DLTOVR     FILE(QAFDACCP)                                
             MONMSG     MSGID(CPF0000)                                
             CLOF       OPNID(QAFDACCP)                               
             MONMSG     MSGID(CPF0000)                                
             OVRDBF     FILE(QAFDACCP) TOFILE(QTEMP/FDF)  SHARE(*YES) 
             OPNQRYF    FILE((QAFDACCP)) QRYSLT('*ALL') +             
                          KEYFLD((APFILE) (APLIB) (APKEYN))           
             CALL       PGM(TOL010) PARM(&F &L &KEYFLD)               
             DLTOVR *ALL                                              
             RCLRSC                                                   
END_PGM:                                                              
             ENDPGM                                                   

/* -------------------------------------*/

RPG Programs TOL010 
      *                                                                   
     FQAFDACCPIP  E                    DISK                               
     FFDFP    IF  E                    DISK                               
     F            QWHFDACP                          KRENAMERCD            
     FSELEC   IF  E                    DISK                               
     FTOL010W CF  E                    WORKSTN                            
     F                                        RECNO KSFILE SFL            
     F                                        RECNO1KSFILE SFL1           
      * ---------------------------------------------------------------   
     E                    FLD        10 10                                
     E                    CMP        10 10                                
     E                    CMP1       10 10                                
     E                    PNT        10  2 0                              
     E                    FLD1       10 10                                
     E                    STR       100  1                                
      * ------------------------------------------------------------------
     IRCD                                                                 
     I              APRCEN                          BPRCEN                
     I              APRDAT                          BPRDAT                
     I              APRTIM                          BPRTIM                
     I              APFILE                          BPFILE                
     I              APLIB                           BPLIB                 
     I              APFTYP                          BPFTYP                
     I              APFTYP                          BPFTYP             
     I              APFILA                          BPFILA             
     I              APMXD                           BPMXD              
     I              APFATR                          BPFATR             
     I              APSYSN                          BPSYSN             
     I              APASP                           BPASP              
     I              APRES                           BPRES              
     I              APMANT                          BPMANT             
     I              APUNIQ                          BPUNIQ             
     I              APKEYO                          BPKEYO             
     I              APSELO                          BPSELO             
     I              APACCP                          BPACCP             
     I              APNSCO                          BPNSCO             
     I              APBOF                           BPBOF              
     I              APBOL                           BPBOL              
     I              APBOLF                          BPBOLF             
     I              APNKYF                          BPNKYF             
     I              APKEYF                          BPKEYF             
     I              APKSEQ                          BPKSEQ             
     I              APKSIN                          BPKSIN             
     I              APKZD                           BPKZD              
     I              APKASQ                          BPKASQ             
     I              APKEYN                          BPKEYN             
     I              APJOIN                          BPJOIN             
     I              APACPJ                          BPACPJ                         
     I              APRIKY                          BPRIKY                          
     I              APUUIV                          BPUUIV                          
      * --------------------------------------------------------------------        
     IQWHFDACP                                                                      
     I                                              APFILEL1                        
     I                                              APLIB L1                        
      * --------------------------------------------------------------------        
     IDS1         DS                                                                
     I                                        1 102 TODO                            
     I                                    B   1   20CNT                             
     I                                        3 102 RESTO                           
     I                                        3 102 CMP                             
     I                                        3  12 C01                             
     I                                       13  22 C02                             
     I                                       23  32 C03                             
     I                                       33  42 C04                             
     I                                       43  52 C05                             
     I                                       53  62 C06                             
     I                                       63  72 C07                             
     I                                       73  82 C08                             
     I                                       83  92 C09                             
     I                                       93 102 C10                             
      * --------------------------------------------------------------------        
     IDS2         DS                                                          
     I                                        1 100 FLD                       
      * --------------------------------------------------------------------  
     IDS3         DS                                                          
     I                                        3 102 CMP1                      
     I                                        3  12 F01                       
     I                                       13  22 F02                       
     I                                       23  32 F03                       
     I                                       33  42 F04                       
     I                                       43  52 F05                       
     I                                       53  62 F06                       
     I                                       63  72 F07                       
     I                                       73  82 F08                       
     I                                       83  92 F09                       
     I                                       93 102 F10                       
      * --------------------------------------------------------------------  
     C         L1          CLEARFLD                                           
      *                                                                       
     C           APKEYN    IFLE CNT                                           
     C           APKEYN    ANDGT0                                             
     C                     Z-ADDAPKEYN    T       50                          
     C                     MOVELAPKEYF    FLD,T                               
     C                     ENDIF                                              
     CL1                   EXSR ANZFIL                                        
     CL1                   MOVE *ON       *IN77                               
     CLR                   EXSR DSPSFL                                        
      * --------------------------------------------------------------------  
     C           *INZSR    BEGSR                                              
     C           *ENTRY    PLIST                                              
     C                     PARM           FILE   10                           
     C                     PARM           LIBR   10                           
     C                     PARM           KYF   100                           
     C                     MOVELKYF       TODO                                
     C                     EXSR ANZFLD                                        
     C                     Z-ADD0         RECNO   60                          
     C                     MOVEA'00'      *IN,30                              
     C                     WRITEFOOT                                          
     C                     WRITECTL                                           
     C                     READ FDFP                     77                   
      *                                                                       
     C           *IN77     DOWEQ*OFF                                          
      *                                                                       
     C           BPKEYN    IFGT 0                                             
     C                     Z-ADDBPKEYN    Z       50                          
     C                     MOVELBPKEYF    CMP1,Z                              
     C                     ENDIF                                              
     C                     READ FDFP                     77                   
     C                     ENDDO                                              
     C                     ENDSR                                                    
      * --------------------------------------------------------------------         
     C           ANZFLD    BEGSR                                                     
     C                     MOVEARESTO     STR,1                                      
     C                     Z-ADD1         P       50                                 
      *                                                                              
     C           1         DO   CNT       Y       40                                 
     C                     MOVEASTR,P     DIEZ   10                                  
     C                     MOVELDIEZ      FLD1,Y                                     
     C                     ADD  10        P                                          
     C                     ENDDO                                                     
     C           CNT       ADD  1         Y                                          
      *                                                                              
     C           Y         DO   10        X       30                                 
     C                     MOVEL*BLANKS   CMP,X                                      
     C                     MOVEL*BLANKS   FLD1,X                                     
     C                     ENDDO                                                     
     C                     ENDSR                                                     
      * --------------------------------------------------------------------         
     C           ANZFIL    BEGSR                                                     
     C                     MOVEAFLD1,1    CIEN  100                                  
     C                     MOVEAFLD,1     CIEN1 100                                  
      *                                                                              
     C           CIEN      IFEQ CIEN1                                                
     C                     EXSR ANZCT1                                   
      *                                                                  
     C           CNTSEL    IFGT 0                                        
     C                     MOVE '+'       SUO                            
     C                     MOVE *OFF      *IN78                          
     C                     ELSE                                          
     C                     MOVE ' '       SUO                            
     C                     MOVE *ON       *IN78                          
     C                     ENDIF                                         
     C                     ADD  1         RECNO                          
     C                     WRITESFL                                      
     C                     ENDIF                                         
     C                     ENDSR                                         
      * -----------------------------------------------------------------
     C           DSPSFL    BEGSR                                         
      *                                                                  
     C           RECNO     IFGT 0                                        
     C                     MOVEA'11'      *IN,30                         
     C                     ELSE                                          
     C                     MOVEA'01'      *IN,30                         
     C                     ENDIF                                         
      *                                                                  
     C           *IN12     DOWEQ*OFF                                     
     C                     WRITEFOOT                                     
     C        N30          WRITEMSG                                             
     C                     EXFMTCTL                                             
     C                     EXSR ANZCTL                                          
     C                     ENDDO                                                
     C                     ENDSR                                                
      * --------------------------------------------------------------------    
     C           ANZCT1    BEGSR                                                
     C                     Z-ADD0         CNTSEL 100                            
     C           1         CHAINSELEC                77                         
      *                                                                         
     C           *IN77     DOWEQ*OFF                                            
      *                                                                         
     C           SOFILE    IFEQ APFILE                                          
     C           SONVAL    ANDNE0                                               
     C                     ADD  1         CNTSEL                                
     C                     ENDIF                                                
     C                     READ SELEC                    77                     
     C                     ENDDO                                                
     C                     ENDSR                                                
      * --------------------------------------------------------------------    
     C           ANZCTL    BEGSR                                                
     C                     READCSFL                    9899                     
      *                                                                         
     C           *IN98     DOWEQ*OFF                                            
     C           *IN99     ANDEQ*OFF                                          
      *                                                                       
     C           OPCSFL    IFEQ '1'                                           
     C                     MOVEA'00'      *IN,32                              
     C                     Z-ADD0         RECNO1  60                          
     C                     WRITEWDWCTL                                        
     C                     EXSR DSPCTL                                        
     C                     MOVE ' '       OPCSFL                              
     C                     MOVE *OFF      *IN78                               
     C                     UPDATSFL                                           
     C                     ENDIF                                              
     C                     READCSFL                    9899                   
     C                     ENDDO                                              
     C                     ENDSR                                              
      * --------------------------------------------------------------------  
     C           DSPCTL    BEGSR                                              
     C           1         CHAINSELEC                77                       
      *                                                                       
     C           *IN77     DOWEQ*OFF                                          
      *                                                                       
     C           SOFILE    IFEQ APFILE                                        
     C                     ADD  1         RECNO1                              
     C                     WRITESFL1                                          
     C                     ENDIF                                              
     C                     READ SELEC                    77                  
     C                     ENDDO                                             
     C                     MOVE *OFF      *IN24                              
      *                                                                      
     C           RECNO1    IFGT 0                                            
     C                     MOVEA'11'      *IN,32                             
     C                     ELSE                                              
     C                     MOVEA'01'      *IN,32                             
     C                     ENDIF                                             
      *                                                                      
     C           *IN24     DOWEQ*OFF                                         
     C                     EXFMTWDWCTL                                       
     C                     ENDDO                                             
     C                     ENDSR                                             
/* DSPF TOL010W  */

    A*%%TS  SD  20010620  185051  VELARDEZV   REL-V4R4M0  5769-PW1              
    A*%%EC                                                                      
    A                                      DSPSIZ(24 80 *DS3)                   
    A          R FOOT                                                           
    A*%%TS  SD  20010613  194722  VELARDEZV   REL-V4R4M0  5769-PW1              
    A                                      CLRL(*NO)                            
    A                                      OVERLAY                              
    A                                 23  3'F12=Cancelar'                       
    A                                      COLOR(BLU)                           
    A          R SFL                       SFL                                  
    A*%%TS  SD  20010620  155030  VELARDEZV   REL-V4R4M0  5769-PW1              
    A            OPCSFL         1A  I 13  3                                     
    A  78                                  DSPATR(PR)                           
    A                                      VALUES(' ' '1')                      
    A            APLIB     R        O 13  5REFFLD(QWHFDACP/APLIB *LIBL/QAFDACC- 
    A                                      P)                                   
    A            APFILE    R        O 13 16REFFLD(QWHFDACP/APFILE *LIBL/QAFDAC- 
    A                                      CP)                                  
    A            SUO            1A  O 13 31DSPATR(HI)                           
    A          R CTL                       SFLCTL(SFL)                          
    A*%%TS  SD  20010620  155030  VELARDEZV   REL-V4R4M0  5769-PW1              
    A                                      SFLSIZ(0017)                         
    A                                      SFLPAG(0008)                         
     A                                      CF12(12)                        
     A                                      OVERLAY                         
     A  30                                  SFLDSP                          
     A  31                                  SFLDSPCTL                       
     A N30                                  SFLCLR                          
     A  30                                  SFLEND(*MORE)                   
     A                                  1  2'TOL010'                        
     A                                  1 28'Analisis de vias de accesos'   
     A                                      DSPATR(HI)                      
     A                                  1 72SYSNAME                         
     A                                  3  2'Archivo. . . . :'              
     A                                      COLOR(BLU)                      
     A            FILE          10A  O  3 19DSPATR(HI)                      
     A                                  4  4'Biblioteca . :'                
     A                                      COLOR(BLU)                      
     A            LIBR          10A  O  4 22DSPATR(HI)                      
     A                                  5  2'Acceso de Fisico'              
     A                                      COLOR(BLU)                      
     A            F01           10A  O  5 19DSPATR(HI)                      
     A            F02           10A  O  5 30DSPATR(HI)                      
     A            F03           10A  O  5 41DSPATR(HI)                      
     A            F04           10A  O  5 52DSPATR(HI)                      
     A            F05           10A  O  5 63DSPATR(HI)                      
     A            F06           10A  O  6 19DSPATR(HI)                      
     A            F07           10A  O  6 30DSPATR(HI)                     
     A            F08           10A  O  6 41DSPATR(HI)                     
     A            F09           10A  O  6 52DSPATR(HI)                     
     A            F10           10A  O  6 63DSPATR(HI)                     
     A                                  7  2'Acceso a buscar:'             
     A                                      COLOR(BLU)                     
     A            C01           10A  O  7 19DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C02           10A  O  7 30DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C03           10A  O  7 41DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C04           10A  O  7 52DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C05           10A  O  7 63DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C06           10A  O  8 19DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C07           10A  O  8 30DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C08           10A  O  8 41DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C09           10A  O  8 52DSPATR(HI)                     
     A                                      DSPATR(UL)                     
     A            C10           10A  O  8 63DSPATR(HI)                           
     A                                      DSPATR(UL)                           
     A                                 12  3'O Libreria   Archivo     Omision'   
     A                                      COLOR(BLU)                           
     A                                 11 27'Seleccion'                          
     A                                      COLOR(BLU)                           
     A                                 10  3'1=Ver Selec/Omit'                   
     A                                      COLOR(BLU)                           
     A          R MSG                                                            
     A*%%TS  SD  20010620  140246  VELARDEZV   REL-V4R4M0  5769-PW1              
     A                                      CLRL(*NO)                            
     A                                      OVERLAY                              
     A                                 10  2'                                  - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                              '                            
     A                                 16 20'(No existen vias de acceso coincid- 
     A                                      entes)'                              
     A                                 16 61'                                  - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                                         - 
     A                                                  '                        
     A          R SFL1                      SFL                                  
     A*%%TS  SD  20010620  184808  VELARDEZV   REL-V4R4M0  5769-PW1              
     A            SORULE    R        O  5 14REFFLD(QWHFDSO/SORULE *LIBL/SELEC)   
     A            SOCOMP    R        O  5 16REFFLD(QWHFDSO/SOCOMP *LIBL/SELEC)   
     A            SOVALU    R        O  5 19REFFLD(QWHFDSO/SOVALU *LIBL/SELEC)     
     A            SOFLD     R        O  5  3REFFLD(QWHFDSO/SOFLD *LIBL/SELEC)       
     A          R WDWCTL                    SFLCTL(SFL1)                            
     A*%%TS  SD  20010620  185051  VELARDEZV   REL-V4R4M0  5769-PW1                 
     A                                      SFLSIZ(0012)                            
     A                                      SFLPAG(0006)                            
     A                                      WINDOW(2 25 12 50)                      
     A                                      CF12(24)                                
     A  32                                  SFLDSP                                  
     A  33                                  SFLDSPCTL                               
     A N32                                  SFLCLR                                  
     A  32                                  SFLEND(*MORE)                           
     A                                  1 38'F12=Cancelar'                          
     A                                      COLOR(BLU)                              
     A                                  3 14'S'                                     
     A                                      COLOR(BLU)                              
     A                                  4  3'Campo      O  Op  Valor'               
     A                                      COLOR(BLU)                              
     A                                  1  1'Seleccion/Omision'                     
     A                                      DSPATR(HI)                              

  

Dig Deeper on iSeries skills

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close