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)