| Nota: Antes de comenzar a
explicar la utilidad y funcionamiento de la aplicación,
quisiera apuntar que la subrutina que sirve para obtener
el día de la semana de una fecha cualquiera (CALDIA),
está cogida de lo publicado en la página de recursos-as400
por Juan Francisco Matoses.
El presente programa sirve para aquellos momentos en
que a un usuario se le solicita seleccionar una fecha
concreta. Mediante la pulsación de la tecla de función
F4 sobre el campo de fecha en cuestión, el programa
mostrará un calendario para permitir al usuario posicionar
el cursor sobre el día deseado y pulsando Enter seleccionar
la fecha en cuestión. Esto permite que el usuario pueda
ver entre otras cosas en que día de la semana cae la
fecha que está seleccionando.
Al programa se le llama pasándole un parámetro en blanco
que es la fecha. La primera pantalla que se ve es un
formato de pantalla (FMT01), creado únicamente para
poder visualizar el resultado por pantalla. Desde aquí
se solicitará la presentación del calendario para poder
seleccionar la fecha deseada.
Pulsando F4 sobre el campo de fecha se llama al programa
pasándole el parámetro de la fecha en blanco. El programa
procede a cargar el calendario con el mes y el año en
curso.
Paginando hacia delante se verá el siguiente mes y
paginando hacia atrás se verá el mes anterior.
Igualmente se puede introducir el mes y el año que
se desean ver introduciéndolos en los campos de selección.
El calendario muestra los meses con un rango que va
desde el año 1950 hasta el año 2050.
Cuando el usuario posiciones el cursor sobre el día
seleccionado y pulse Enter, la fecha total seleccionada
será devuelta por el programa.
Pulsando Enter el programa devolverá la fecha en cuestión.
Código fuente de la pantalla
A*%%TS SD 20011008 164503 TINPG03 REL-V4R4M0 5769-PW1
A*%%EC
A DSPSIZ(24 80 *DS3)
A R FMT01
A*%%TS SD 20011001 183137 TINPG03 REL-V4R4M0 5769-PW1
A CF03(03 'Salir')
A CF04(04 'Visualizar calendario')
A OVERLAY
A 7 18'Introduzca la fecha (DD/MM/AAAA) :'
A COLOR(BLU)
A DSFECH 8Y 0B 7 54EDTWRD(' / / ')
A 21 2' -
A -
A '
A DSPATR(UL)
A COLOR(BLU)
A 23 4'F3: Salir'
A 18 3'Nota:'
A COLOR(BLU)
A 18 10'Pulsando'
A 18 22'sobre el campo de fecha podr visu-
A lizar el calendario para s-
A eleccionar la fecha que se desee.'
A 18 19'F4'
A COLOR(WHT)
A R WIN01
A*%%TS SD 20011008 164503 TINPG03 REL-V4R4M0 5769-PW1
A CF03(03 'Salir')
A ROLLUP(90 'Pagina adelante')
A ROLLDOWN(91 'Pagina atr s')
A RTNCSRLOC(® &CAMPO)
A WINDOW(5 24 13 30)
A WDWBORDER((*COLOR TRQ) (*DSPATR RI)-
A (*CHAR ' '))
A 1 11'CALENDARIO'
A COLOR(YLW)
A DSPATR(RI)
A 2 1'Mes..:'
A 2 22'A¤o:'
A 4 4'L'
A 4 8'M'
A 4 12'X'
A 4 16'J'
A 4 20'V'
A 4 24'S'
A 4 28'D'
A 11 2'Roll Up/Down = Futuro/Pasado'
A COLOR(BLU)
A RPMESC 2Y 0B 2 8EDTCDE(4)
A COLOR(TRQ)
A 81 DSPATR(RI)
A 81 DSPATR(PC)
A 81 ERRMSG(' Mes debe estar entre 01 y -
A 12')
A RPANOC 4Y 0B 2 27EDTCDE(4)
A 82 DSPATR(RI)
A 82 DSPATR(PC)
A COLOR(TRQ)
A 82 ERRMSG(' A¤o debe ser superior a 19-
A 50')
A 83 ERRMSG(' A¤o debe ser inferior a 20-
A 50')
A RPANO1 4S 0O 3 2COLOR(WHT)
A RPMESL 10A O 3 11COLOR(WHT)
A RPANO2 4S 0O 3 26COLOR(WHT)
A RPTB01 2A O 5 3COLOR(WHT)
A RPTB02 2A O 5 7COLOR(WHT)
A RPTB03 2A O 5 11COLOR(WHT)
A RPTB04 2A O 5 15COLOR(WHT)
A RPTB05 2A O 5 19COLOR(WHT)
A RPTB06 2A O 5 23COLOR(RED)
A RPTB07 2A O 5 27COLOR(RED)
A RPTB08 2A O 6 3COLOR(WHT)
A RPTB09 2A O 6 7COLOR(WHT)
A RPTB10 2A O 6 11COLOR(WHT)
A RPTB11 2A O 6 15COLOR(WHT)
A RPTB12 2A O 6 19COLOR(WHT)
A RPTB13 2A O 6 23COLOR(RED)
A RPTB14 2A O 6 27COLOR(RED)
A RPTB15 2A O 7 3COLOR(WHT)
A RPTB16 2A O 7 7COLOR(WHT)
A RPTB17 2A O 7 11COLOR(WHT)
A RPTB18 2A O 7 15COLOR(WHT)
A RPTB19 2A O 7 19COLOR(WHT)
A RPTB20 2A O 7 23COLOR(RED)
A RPTB21 2A O 7 27COLOR(RED)
A RPTB22 2A O 8 3COLOR(WHT)
A RPTB23 2A O 8 7COLOR(WHT)
A RPTB24 2A O 8 11COLOR(WHT)
A RPTB25 2A O 8 15COLOR(WHT)
A RPTB26 2A O 8 19COLOR(WHT)
A RPTB27 2A O 8 23COLOR(RED)
A RPTB28 2A O 8 27COLOR(RED)
A RPTB29 2A O 9 3COLOR(WHT)
A RPTB30 2A O 9 7COLOR(WHT)
A RPTB31 2A O 9 11COLOR(WHT)
A RPTB32 2A O 9 15COLOR(WHT)
A RPTB33 2A O 9 19COLOR(WHT)
A RPTB34 2A O 9 23COLOR(RED)
A RPTB35 2A O 9 27COLOR(RED)
A RPTB36 2A O 10 3COLOR(WHT)
A RPTB37 2A O 10 7COLOR(WHT)
A WSERRO 30 O 12 1COLOR(WHT)
A REG 10A H
A CAMPO 10A H
Código fuente del programa
********************************************************
* *
* CALENDARIO *
* *
* PROGRAMA : CALEN01 *
* *
* DESCRIPCIàN : Se le debe pasar por par metros la fecha de *
* 8 posiciones alfanum‚ricas. El programa mues-*
* tra el calendario del mes actual. Por ReP g *
* muestra el mes anterior y por AvP g el si- *
* guiente. Se puede visualizar un mes determi- *
* nado de un a¤os determinado introduciendo los *
* datos en los campos habilitados a tal efecto. *
* Se puede seleccionar la fecha exacta que se *
* desea situando el cursor sobre el d¡a deseado *
* y pulsando Enter. As¡ se nos devolver al *
* r metro la fecha seleccionada. *
* *
* FECHA : 02 de OCTUBRE de 2001 *
* *
* AUTOR : LUIS GONZALEZ GERPE *
* *
* INDICADORES : 03 - Sale del programa. *
* 04 - Sobre campo fecha despliega calendario.*
* 80 - Indicador de Error en Ventana. *
* 81 - Error, el mes no est entre 1 y 12. *
* 82 - Error, el a¤o no es superior a 1950. *
* 83 - Error, el a¤o no es inferior a 2100. *
* 90 - Pagina hacia adelante. *
* 91 - Pagina hacia atr s. *
* *
********************************************************
*
H D
*
********************************************************
* DESCRIPCION DE ARCHIVOS *
********************************************************
*
* Fichero de pantalla
*
FCALENFM CF E WORKSTN
F KINFDS INFDS
*
********************************************************
* SERIES DE DATOS *
********************************************************
*
* Serie para obtener el nombre del mes
*
E SCM 1 12 10
*
* Serie para grabar los d¡as del calendario
*
E SCD 1 37 2
*
********************************************************
* Estructuras de Datos *
********************************************************
*
* Posicionamiento del cursor
*
IINFDS DS
I 370 370 LIN
I 371 371 COL
*
I DS
I B 1 20BLIN
I 2 2 CLIN
I B 3 40BCOL
I 4 4 CCOL
*
* Fecha en formato dd/mm/aaaa
*
I DS
I 1 80FECHA
I 1 20DIA
I 3 40MES
I 5 80ANO
*
********************************************************
* PROCESO PRINCIPAL *
********************************************************
*
C EXSR INICIO
C EXSR PROCES
C EXSR FIN
*
********************************************************
* INICIO - Subrrutina de Inicio de programa *
********************************************************
*
C INICIO BEGSR
*
* Par metro de entrada
*
C *ENTRY PLIST
C PARM PAFECH 8
*
* Variables de trabajo
*
C Z-ADD1 WKDIAI 20 D¡a Inicio
C Z-ADD1 WKNDIA 20 N§ dias mes
C Z-ADD1 WKDIAA 20 D¡a Actual
C MOVE *BLANKS WKDIAD 2 D¡a Definit.
C MOVE *BLANKS WKMESP 2 Mes
C Z-ADD1 WKMESN 20 Mes
C MOVE *BLANKS WKANOP 4 A¤o (4 dig)
C Z-ADD1 WKANON 40 A¤o (4 dig)
C Z-ADD1 WKCONT 20 Contador
C Z-ADD1 Y 20 D¡a semana
C Z-ADD1 Z 20 Mes (corto)
C Z-ADD1 P 20 Posici¢n mat
C MOVE *DATE WKFECH 8 FECHA SIST.
C MOVE *BLANKS FECHAW 4 FECHA TEMP
C MOVE *BLANKS FECHAX 8 FECHA TEMP
*
C ENDSR
*
********************************************************
* PROCES - Subrrutina de Proceso Principal del programa *
********************************************************
*
C PROCES BEGSR
*
C *IN03 DOWEQ*OFF
*
C MOVE WKFECH FECHA
*
C EXSR CALDAT Calc. Datos
*
C EXFMTFMT01
C Z-ADD*ZEROS DSFECH
C 03 LEAVE
*
C Z-ADD0 BLIN
C Z-ADD0 BCOL
C MOVE LIN CLIN
C MOVE COL CCOL
*
C *IN04 IFEQ *ON
C BLIN ANDEQ7
C BCOL ANDGE54
C BCOL ANDLE63
C SETOF 04
C EXSR CALCAL
C EXFMTWIN01
C EXSR PAGINA
*
C *IN03 DOWEQ*OFF
C DSFECH ANDEQ*ZEROS
C EXSR VALFEC
C *IN80 IFEQ *OFF NO ERROR
C EXSR CALDIA
C EXSR CALCAL
C ENDIF NO ERROR
C EXFMTWIN01
C EXSR PAGINA
*
C *IN03 IFEQ *ON
C SETOF 03
C LEAVE
C ENDIF
*
C ENDDO
*
C ENDIF
*
C SETOF 03
C SETOF 808182
C SETOF 83
C MOVE *BLANKS WSERRO
*
C ENDDO
*
C ENDSR
*
*****************************************************
* FIN - Subrrutina de fin de programa *
*****************************************************
*
C FIN BEGSR
*
C SETON LR
C RETRN
*
C ENDSR
*
*****************************************************
* CALDAT - SUBRUTINA DE CALCULO DE DATOS *
* D¡a de la Semana / Ordinal del d¡a / Ordinal del *
* mes / D¡a de Inicio *
*****************************************************
*
C CALDAT BEGSR
*
* Obtenemos el ordinal del d¡a actual
*
C Z-ADDDIA WKDIAA
*
* Obtenemos el ordinal del mes actual
*
C MOVE MES WKMESP
*
* Obtenemos el a¤o actual
*
C MOVE ANO WKANOP A¤o (4 dig)
*
* Obtenemos el ordinal del d¡a de la semana en que estamos
*
C MOVE WKMESP RPMESC
C MOVE WKANOP RPANOC
*
C EXSR CALDIA
*
* Obtenemos el d¡a de la semana en q debe iniciar el mes a contar
*
C WKDIAA IFGT 7
C WKDIAA SUB WKDIAI D1 20
C D1 DOWGT7
C D1 SUB 7 D1 20
C ENDDO
C 7 SUB D1 D1
C 1 ADD D1 Y
C ELSE
C MOVE DIA WKDIAI
C ENDIF
*
C ENDSR
*
*****************************************************
* CALCAL - SUBRUTINA DE CALCULO DEL CALENDARIO *
* Calcula los d¡as que corresponden al mes en pro- *
* ceso. *
*****************************************************
*
C CALCAL BEGSR
*
C CLEARSCD
*
C EXSR DIAMES D¡as del Mes
*
C MOVE WKANOP RPANOC
C MOVE WKANOP RPANO1
C MOVE WKANOP RPANO2
C MOVE WKMESP RPMESC
C MOVE RPMESC Z Ordinal mes
C MOVEASCM,Z RPMESL
*
C Z-ADD1 WKCONT Contador d¡a
C MOVE WKDIAI Y
*
C WKCONT DOWLEWKNDIA
C MOVE WKCONT SCD,Y
C ADD 1 WKCONT
C ADD 1 Y
C ENDDO
*
C EXSR MUEVE Mueve a pant
*
C ENDSR
*
*****************************************************
* DIAMES - SUBRUTINA PARA CALCULA N§ DE DÖAS DEL MES *
* Calcula el n£mero de d¡as que contiene el mes *
*****************************************************
*
C DIAMES BEGSR
*
C MOVE WKMESP WKMESN
C MOVE WKANOP WKANON
*
C SELEC
* ENERO
C WKMESN WHEQ 1
C Z-ADD31 WKNDIA
* FEBRERO
C WKMESN WHEQ 2
*
C WKANON DIV 4 WKCOC1 40
C MVR WKRES1 10
C WKANON DIV 100 WKCOC2 40
C MVR WKRES2 20
C WKANON DIV 400 WKCOC3 40
C MVR WKRES3 30
*
* A¤o bisiesto
* Div entre 4 --> Bisiesto / Div entre 100 --> No bisiesto
* Div entre 400 --> Bisiesto
*
C WKRES1 IFEQ 0
C WKRES2 ANDNE0
C WKRES3 OREQ 0
C Z-ADD29 WKNDIA
C ELSE
* A¤o no bisiesto
C Z-ADD28 WKNDIA
C ENDIF
* MARZO
C WKMESN WHEQ 3
C Z-ADD31 WKNDIA
* ABRIL
C WKMESN WHEQ 4
C Z-ADD30 WKNDIA
* MAYO
C WKMESN WHEQ 5
C Z-ADD31 WKNDIA
* JUNIO
C WKMESN WHEQ 6
C Z-ADD30 WKNDIA
* JULIO
C WKMESN WHEQ 7
C Z-ADD31 WKNDIA
* AGOSTO
C WKMESN WHEQ 8
C Z-ADD31 WKNDIA
* SEPTIEMBRE
C WKMESN WHEQ 9
C Z-ADD30 WKNDIA
* OCTUBRE
C WKMESN WHEQ 10
C Z-ADD31 WKNDIA
* NOVIEMBRE
C WKMESN WHEQ 11
C Z-ADD30 WKNDIA
* DICIEMBRE
C WKMESN WHEQ 12
C Z-ADD31 WKNDIA
*
C ENDSL
*
C ENDSR
*
*****************************************************
* MUEVE - SUBRUTINA PARA MOVER CAMPOS A PANTALLA *
* Mueve campos de la tabla a la pantalla *
*****************************************************
*
C MUEVE BEGSR
*
C MOVE SCD,1 RPTB01
C MOVE SCD,2 RPTB02
C MOVE SCD,3 RPTB03
C MOVE SCD,4 RPTB04
C MOVE SCD,5 RPTB05
C MOVE SCD,6 RPTB06
C MOVE SCD,7 RPTB07
C MOVE SCD,8 RPTB08
C MOVE SCD,9 RPTB09
C MOVE SCD,10 RPTB10
C MOVE SCD,11 RPTB11
C MOVE SCD,12 RPTB12
C MOVE SCD,13 RPTB13
C MOVE SCD,14 RPTB14
C MOVE SCD,15 RPTB15
C MOVE SCD,16 RPTB16
C MOVE SCD,17 RPTB17
C MOVE SCD,18 RPTB18
C MOVE SCD,19 RPTB19
C MOVE SCD,20 RPTB20
C MOVE SCD,21 RPTB21
C MOVE SCD,22 RPTB22
C MOVE SCD,23 RPTB23
C MOVE SCD,24 RPTB24
C MOVE SCD,25 RPTB25
C MOVE SCD,26 RPTB26
C MOVE SCD,27 RPTB27
C MOVE SCD,28 RPTB28
C MOVE SCD,29 RPTB29
C MOVE SCD,30 RPTB30
C MOVE SCD,31 RPTB31
C MOVE SCD,32 RPTB32
C MOVE SCD,33 RPTB33
C MOVE SCD,34 RPTB34
C MOVE SCD,35 RPTB35
C MOVE SCD,36 RPTB36
C MOVE SCD,37 RPTB37
*
C ENDSR
*
*****************************************************
* CALDIA - SUBRUTINA DE CALCULO DEL DÖA DE LA SEMANA *
* Calcula el d¡a de la semana de cualquier fecha *
*****************************************************
*
C CALDIA BEGSR
*
* Necesitamos componer la fecha en Fmto. 'DDMMAAAA'
*
C Z-ADDRPMESC WKMESN
C Z-ADDRPMESC WKMESN
C Z-ADDRPANOC WKANON
C MOVE RPMESC WKMESP
C MOVE RPANOC WKANOP
C MOVE *BLANKS FECHAW
C MOVE *BLANKS FECHAX
C '01' CAT WKMESP FECHAW
C FECHAW CAT WKANOP FECHAX
C MOVE FECHAX FECHA
*
C Z-ADD0 A1 50
C Z-ADD0 A2 50
C Z-ADD0 A3 50
C Z-ADD0 A4 50
C Z-ADD0 A5 50
*
C MES IFGT 2
C Z-ADDANO J 40
C Z-ADDMES K 40
C ELSE
C ANO SUB 1 J
C MES ADD 12 K
C ENDIF
*
C DIA SUB 1 A1
C 5 MULT J A2
C A2 DIV 4 A2
C A1 ADD A2 A2
C J DIV 100 A3
C A2 SUB A3 A3
C J DIV 400 A4
C A3 ADD A4 A4
C K ADD 1 A5
C 13 MULT A5 A5
C A5 DIV 5 A5
C A4 ADD A5 A5
C A5 DIV 7 A5
C MVR RESTO 10
*
C RESTO IFEQ 0
C Z-ADD7 RESTO
C ENDIF
*
C Z-ADDRESTO WKDIAI
*
C ENDSR
*
*****************************************************
* VALFEC - SUBRUTINA DE VALIDACION DE FECHA INTRODUCIDA *
* Valida la nueva fecha que se le haya introducido *
*****************************************************
*
C VALFEC BEGSR
*
C SETOF 808182
C SETOF 83
C MOVE *BLANKS WSERRO
*
* Mes menor de '01' o mayor de '12' ---> Error 81
*
C RPMESC IFLT 01
C RPMESC ORGT 12
C SETON 8081
C ELSE
*
* A¤o menor de '1950' -----------------> Error 82
*
C RPANOC IFLT 1950
C SETON 8082
C ENDIF
*
* A¤o mayor de '2050' -----------------> Error 83
*
C RPANOC IFGT 2050
C SETON 8083
C ENDIF
*
C ENDIF
*
C ENDSR
*
*****************************************************
* PAGINA - SUBRUTINA DE VALIDACION DE PAGINACION *
* Valida que se haya paginado arriba o abajo en *
* tales casos calcula el siguiente o el ant. mes. *
*****************************************************
*
C PAGINA BEGSR
*
* Pagina hacia adelante
*
C *IN90 IFEQ *ON
*
C RPMESC IFEQ 12
C Z-ADD1 RPMESC
C ADD 1 RPANOC
C ELSE
C ADD 1 RPMESC
C ENDIF
*
C ELSE
*
* Pagina hacia atr s
*
C *IN91 IFEQ *ON
*
C RPMESC IFEQ 1
C Z-ADD12 RPMESC
C SUB 1 RPANOC
C ELSE
C SUB 1 RPMESC
C ENDIF
*
C ELSE
*
C *IN03 IFEQ *OFF
C EXSR ESCFEC
C ENDIF
*
C ENDIF
*
C ENDIF
*
C ENDSR
*
*****************************************************
* ESCFEC - ESCRIBE LA FECHA *
* Busca el campo sobre el que estaba el cursor y *
* obtiene el d¡a que hay en dicho campo con este *
* con el mes y con a¤o compone la fecha resultante *
*****************************************************
*
C ESCFEC BEGSR
*
C 4 SUBSTCAMPO:1 WKCUER 4 CUERPO
C 2 SUBSTCAMPO:5 WKNORD 2 N§ ORD.
*
C WKCUER IFEQ 'RPTB'
C MOVE WKNORD P
C MOVEASCD,P WKDIAD
C WKDIAD IFNE *BLANKS
C MOVE WKDIAD DIA
C MOVE RPMESC MES
C MOVE RPANOC ANO
C MOVELFECHA PAFECH
C MOVELPAFECH DSFECH
C ENDIF
C ENDIF
*
C ENDSR
*
**
Enero
Febrero
Marzo
Abril
Mayo
Junio
Julio
Agosto
Septiembre
Octubre
Noviembre
Diciembre
**
Ver truco
Ver
código fuente
Descargar truco en PDF
|
