Procedimientos: Pedir fecha larga ($=8)

Pedir fecha larga ($=8)


A través de la función que a continuación se detalla, obtendremos una fecha válida. Dicha fecha se pedirá directamente con los comandos de condición [if then else endif]. asimismo y a través de la misma pasaremos los parámetros [xFila y xColumna], para que la aplicación nos la muestre en la posición que creamos oportuna:

PROC PideFecha8(xcol#,xfil#,xfec$=8) : %
FIELD=M
DCL Mascara%
DCL Fecha$=8
FIELD=M,Fecha
DCL ano$=4,mes$=2,dia$=2
ENDLOC

mascara=MASK
MASK 811

fecha=xfec
IF (fecha==" ")
dia="00" :: mes="00" :: ano=CONV(JJANO(PT))
ENDIF
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano

&dia
REPEAT
ASK=1,I=&escape:TAB(xcol,xfil),(NN)=dia
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
UNTIL (CONV#(dia)<32)
IF dia="00"
mes="00"
ano="0000"
xfec=fecha
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
MASK mascara
EXIT (88)
ENDIF
&mes
REPEAT
ASK=1,I=&dia:TAB(xcol+3,xfil),(NN)=mes
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
UNTIL (CONV#(mes)>0) AND (CONV#(mes)<13)
SELECT CONV#(mes) ; CONTROL DE DIA DEL MES
CASE 4,6,9,11 :: IF CONV#(dia)>30 : GOTO &mes
CASE 2 :: IF CONV#(dia)>29 : GOTO &mes
ENDSEL

&ano
ASK=1,I=&mes:TAB(xcol+6,xfil),(n4)=ano
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
IF (CONV#(mes)=2) AND (MOD(CONV%(ano),4)<>0) AND (CONV#(dia)>28) : GOTO &dia
IF (CONV%(ANO)<>0) AND (CONV%(ANO)<1900) : GOTO &ANO

MASK mascara
xfec=fecha
EXIT (0)

&escape
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
MASK mascara
EXIT (99)
ENDPROC

SINTAXIS

IF pidefecha8(26,19,FechaPedida?)=99 : goto &Fin

Si la función devuelve 99, es que han pulsado escape dentro de la función.
Si la función devuelve 88, es que han pulsado intro dentro de la función, pero el valor que devuelve es 00/00/0000.
Si la función devuelve 0, es que han introducido un valor válido de fecha.