0001.00 ***************************************************************** 0002.00 * * 0003.00 * CONVERSION DE FECHA A TEXTO * 0004.00 * * 0005.00 ***************************************************************** 0006.00 H/EJECT 0007.00 H DECEDIT('0,') ALTSEQ(*EXT) DATEDIT(*DMY.) 0008.00 * 0009.00 D* 0010.00 D* TABLAS DE TRABAJO 0011.00 D* 0012.00 D D S 13 DIM(43) CTDATA PERRCD(1) 0013.00 D C S 14 DIM(10) CTDATA PERRCD(1) 0014.00 D M S 11 DIM(12) CTDATA PERRCD(1) 0015.00 D A S 26 DIM(2) CTDATA PERRCD(1) 0016.00 D* 0017.00 D* TABLAS DE TRABAJO 0018.00 D* 0019.00 D TEX S 1 DIM(80) 0020.00 D CAM S 1 DIM(80) 0021.00 * 0022.00 ***************************************************************** 0023.00 * * 0024.00 * ESTRUCTURAS DE DATOS * 0025.00 * * 0026.00 ***************************************************************** 0027.00 D DS 0028.00 D AÑO 1 4 0 0029.00 D MES 5 6 0 0030.00 D DIA 7 8 0 0031.00 D FECHA 1 8 0 0032.00 D DS 0033.00 D NO1 1 30 0034.00 D NO2 31 60 0035.00 D NO3 61 80 0036.00 D FECHN 1 80 0037.00 ***************************************************************** 0038.00 * * 0039.00 * PROCESO INICIAL * 0040.00 * * 0041.00 ***************************************************************** 0042.00 * 0043.00 * PARMETROS TRANSFERIDOS 0044.00 * 0045.00 * SWFEC - CAMPO PARA FECHA 0046.00 * 0047.00 * SWNO1 - CAMPO DE RETORNO 1 0048.00 * SWNO2 - CAMPO DE RETORNO 2 0049.00 * SWNO3 - CAMPO DE RETORNO 3 0050.00 * 0051.00 C *ENTRY PLIST 0052.00 C PARM SWFEC 8 0053.00 C PARM SWNO1 30 0054.00 C PARM SWNO2 30 0055.00 C PARM SWNO3 20 0056.00 * 0057.00 * INICIALIZACION DE CONSTANTES 0058.00 * 0059.00 C MOVE SWFEC FECHA 0060.00 C MOVE AÑO AÑO2 2 0 0061.00 C EXSR NOMNUM 0062.00 C MOVE NO1 SWNO1 0063.00 C MOVE NO2 SWNO2 0064.00 C MOVE NO3 SWNO3 0065.00 C SETON LR 0066.00 ***************************************************************** 0067.00 * * 0068.00 * NOMNUM: TRASFORMA FECHA DE NUMERO A NOMBRE * 0069.00 * * 0070.00 ***************************************************************** 0071.00 C NOMNUM BEGSR 0072.00 C* 0073.00 C MOVE *BLANKS BLANCO 80 0074.00 C MOVEA BLANCO TEX 0075.00 C MOVEA BLANCO CAM 0076.00 C MOVEA D(DIA) CAM 0077.00 C Z-ADD 1 N 2 0 0078.00 C Z-ADD 1 Z 2 0 0079.00 C N DOWLE 13 0080.00 C MOVE CAM(N) TEX(Z) 0081.00 C CAM(N) IFEQ ' ' 0082.00 C *IN70 IFEQ '0' 0083.00 C SETON 70 0084.00 C ELSE 0085.00 C SETOFF 70 0086.00 C Z-ADD 13 N 0087.00 C SUB 1 Z 0088.00 C END 0089.00 C ELSE 0090.00 C SETOFF 70 0091.00 C END 0092.00 C ADD 1 N 0093.00 C ADD 1 Z 0094.00 C ENDDO 0095.00 C DIA IFEQ 31 0096.00 C MOVEA BLANCO CAM 0097.00 C MOVEA D(1) CAM 0098.00 C Z-ADD 1 N 2 0 0099.00 C N DOWLE 13 0100.00 C MOVE CAM(N) TEX(Z) 0101.00 C CAM(N) IFEQ ' ' 0102.00 C *IN70 IFEQ '0' 0103.00 C SETON 70 0104.00 C ELSE 0105.00 C SETOFF 70 0106.00 C Z-ADD 13 N 0107.00 C SUB 1 Z 0108.00 C END 0109.00 C ELSE 0110.00 C SETOFF 70 0111.00 C END 0112.00 C ADD 1 N 0113.00 C ADD 1 Z 0114.00 C ENDDO 0115.00 C END 0116.00 C* 0117.00 C MOVE 'd' TEX(Z) 0118.00 C ADD 1 Z 0119.00 C MOVE 'e' TEX(Z) 0120.00 C ADD 2 Z 0121.00 C* 0122.00 C MOVEA BLANCO CAM 0123.00 C MOVEA M(MES) CAM 0124.00 C Z-ADD 1 N 2 0 0125.00 C N DOWLE 11 0126.00 C MOVE CAM(N) TEX(Z) 0127.00 C CAM(N) IFEQ ' ' 0128.00 C *IN70 IFEQ '0' 0129.00 C SETON 70 0130.00 C ELSE 0131.00 C SETOFF 70 0132.00 C Z-ADD 11 N 0133.00 C SUB 1 Z 0134.00 C END 0135.00 C ELSE 0136.00 C SETOFF 70 0137.00 C END 0138.00 C ADD 1 N 0139.00 C ADD 1 Z 0140.00 C ENDDO 0141.00 C* 0142.00 C MOVE 'd' TEX(Z) 0143.00 C ADD 1 Z 0144.00 C MOVE 'e' TEX(Z) 0145.00 C ADD 1 Z 0146.00 C* 0147.00 C AÑO IFLT 2000 0148.00 C ADD 1 Z 0149.00 C MOVEA BLANCO CAM 0150.00 C MOVEA A(1) CAM 0151.00 C Z-ADD 1 N 2 0 0152.00 C N DOWLE 26 0153.00 C MOVE CAM(N) TEX(Z) 0154.00 C CAM(N) IFEQ ' ' 0155.00 C *IN70 IFEQ '0' 0156.00 C SETON 70 0157.00 C ELSE 0158.00 C SETOFF 70 0159.00 C Z-ADD 26 N 0160.00 C SUB 1 Z 0161.00 C END 0162.00 C ELSE 0163.00 C SETOFF 70 0164.00 C END 0165.00 C ADD 1 N 0166.00 C ADD 1 Z 0167.00 C ENDDO 0168.00 C ELSE 0169.00 C ADD 1 Z 0170.00 C MOVEA BLANCO CAM 0171.00 C MOVEA A(2) CAM 0172.00 C Z-ADD 1 N 2 0 0173.00 C N DOWLE 26 0174.00 C MOVE CAM(N) TEX(Z) 0175.00 C CAM(N) IFEQ ' ' 0176.00 C *IN70 IFEQ '0' 0177.00 C SETON 70 0178.00 C ELSE 0179.00 C SETOFF 70 0180.00 C Z-ADD 26 N 0181.00 C SUB 1 Z 0182.00 C END 0183.00 C ELSE 0184.00 C SETOFF 70 0185.00 C END 0186.00 C ADD 1 N F3=Salir F4=Solicitud F5=Renovar F9=Recuperar F10=Cursor F11=Conmutar F16=Repetir búsqueda F17=Repetir cambio F24=Más teclas Columnas . . : 6 76 Edición AULIBD/QRPGLESRC SEU==> AUFECH FMT C CL0N01Factor1+++++++Operac&ExtFactor2+++++++Resultado+++++Lon++D+MaMeIg 0187.00 C ADD 1 Z 0188.00 C ENDDO 0189.00 C END 0190.00 C MOVE AÑO AÑO3 3 0 0191.00 C MOVEL AÑO3 AÑ13 1 0 0192.00 C Z-ADD AÑ13 A13 2 0 0193.00 C AÑO3 IFGT 0 0194.00 C AÑ13 IFGT 0 0195.00 C AÑO3 IFEQ 100 0196.00 C MOVEA BLANCO CAM 0197.00 C MOVEA C(A13) CAM 0198.00 C ELSE 0199.00 C ADD 1 A13 0200.00 C MOVEA BLANCO CAM 0201.00 C MOVEA C(A13) CAM 0202.00 C END 0203.00 C Z-ADD 1 N 2 0 0204.00 C N DOWLE 14 0205.00 C MOVE CAM(N) TEX(Z) 0206.00 C CAM(N) IFEQ ' ' 0207.00 C *IN70 IFEQ '0' 0208.00 C SETON 70 0209.00 C ELSE 0210.00 C SETOFF 70 0211.00 C Z-ADD 14 N 0212.00 C SUB 1 Z 0213.00 C END 0214.00 C ELSE 0215.00 C SETOFF 70 0216.00 C END 0217.00 C ADD 1 N 0218.00 C ADD 1 Z 0219.00 C ENDDO 0220.00 C END 0221.00 C* 0222.00 C AÑO2 IFGT 0 0223.00 C AÑO2 IFLT 31 0224.00 C MOVEA BLANCO CAM 0225.00 C MOVEA D(AÑO2) CAM 0226.00 C Z-ADD 1 N 2 0 0227.00 C N DOWLE 13 0228.00 C MOVE CAM(N) TEX(Z) 0229.00 C CAM(N) IFEQ ' ' 0230.00 C *IN70 IFEQ '0' 0231.00 C SETON 70 0232.00 C ELSE 0233.00 C SETOFF 70 0234.00 C Z-ADD 13 N 0235.00 C SUB 1 Z 0236.00 C END 0237.00 C ELSE 0238.00 C SETOFF 70 0239.00 C END 0240.00 C ADD 1 N 0241.00 C ADD 1 Z 0242.00 C ENDDO 0243.00 C* 0244.00 C ELSE 0245.00 C MOVE AÑO2 AÑO1 1 0 0246.00 C MOVEL AÑO2 AÑ11 1 0 0247.00 C Z-ADD AÑ11 A11 2 0 0248.00 C A11 IFGE 3 0249.00 C Z-ADD 30 H 2 0 0250.00 C SUB 3 A11 0251.00 C 2 MULT A11 A11 0252.00 C ADD A11 H 0253.00 C AÑO1 IFGT 0 0254.00 C ADD 1 H 0255.00 C END 0256.00 C MOVEA BLANCO CAM 0257.00 C MOVEA D(H) CAM 0258.00 C ELSE 0259.00 C MOVEA BLANCO CAM 0260.00 C MOVEA D(AÑO2) CAM 0261.00 C END 0262.00 C Z-ADD 1 N 2 0 0263.00 C N DOWLE 13 0264.00 C MOVE CAM(N) TEX(Z) 0265.00 C CAM(N) IFEQ ' ' 0266.00 C *IN70 IFEQ '0' 0267.00 C SETON 70 0268.00 C ELSE 0269.00 C SETOFF 70 0270.00 C Z-ADD 13 N 0271.00 C SUB 1 Z 0272.00 C END 0273.00 C ELSE 0274.00 C SETOFF 70 0275.00 C END 0276.00 C ADD 1 N 0277.00 C ADD 1 Z 0278.00 C ENDDO 0279.00 C AÑO1 IFGT 0 0280.00 C MOVEA BLANCO CAM 0281.00 C MOVEA D(AÑO1) CAM 0282.00 C Z-ADD 1 N 2 0 0283.00 C N DOWLE 13 0284.00 C MOVE CAM(N) TEX(Z) 0285.00 C CAM(N) IFEQ ' ' 0286.00 C *IN70 IFEQ '0' 0287.00 C SETON 70 0288.00 C ELSE 0289.00 C SETOFF 70 0290.00 C Z-ADD 13 N 0291.00 C SUB 1 Z 0292.00 C END 0293.00 C ELSE 0294.00 C SETOFF 70 0295.00 C END 0296.00 C ADD 1 N 0297.00 C ADD 1 Z 0298.00 C ENDDO 0299.00 C END 0300.00 C END 0301.00 C END 0302.00 C END 0303.00 C SUB 1 Z 0304.00 C MOVE '.' TEX(Z) 0305.00 C MOVEA TEX FECHN 0306.00 C* 0307.00 C ENDSR 0308.00 C/EJECT 0309.00 ** 0310.00 uno 0311.00 dos 0312.00 tres 0313.00 cuatro 0314.00 cinco 0315.00 seis 0316.00 siete 0317.00 ocho 0318.00 nueve 0319.00 diez 0320.00 once 0321.00 doce 0322.00 trece 0323.00 catorce 0324.00 quince 0325.00 dieciseis 0326.00 diecisiete 0327.00 dieciocho 0328.00 diecinueve 0329.00 veinte 0330.00 veintiuno 0331.00 veintidos 0332.00 veintitres 0333.00 veinticuatro 0334.00 veinticinco 0335.00 veintiseis 0336.00 veintisiete 0337.00 veintiocho 0338.00 veintinueve 0339.00 treinta 0340.00 treinta y 0341.00 cuarenta 0342.00 cuarenta y 0343.00 cincuenta 0344.00 cincuenta y 0345.00 sesenta 0346.00 sesenta y 0347.00 setenta 0348.00 setenta y 0349.00 ochenta 0350.00 ochenta y 0351.00 noventa 0352.00 noventa y 0353.00 ** 0354.00 cien 0355.00 ciento 0356.00 doscientos 0357.00 trescientos 0358.00 cuatrocientos 0359.00 quinientos 0360.00 seiscientos 0361.00 setecientos 0362.00 ochocientos 0363.00 novecientos 0364.00 ** 0365.00 enero 0366.00 febrero 0367.00 marzo 0368.00 abril 0369.00 mayo 0370.00 junio 0371.00 julio 0372.00 agosto 0373.00 septiembre 0374.00 octubre 0375.00 noviembre 0376.00 diciembre 0377.00 ** 0378.00 mil 0379.00 dos mil