Método de las Décadas ABC

Código fuente COBOL 'DecadasABC.COB'

1. Seleccione con el mouse el texto disponible más abajo entre las dos líneas rojas.

2. Mediante las opciones de Copiar y Pegar llévelo al Block de Notas y grábelo en su disco duro como DecadasABC.cob

3. Transfiéralo al host mediante cualquier software de transferencia de archivos.

4. El el host realice las siguientes instrucciones:

   1. COBOL DecadasABC ---------------// Compilación de subprograma (Se genera DecadasABC.obj)

   2. COBOL TestABC--------------------// Compilación de programa llamador (Se genera TestABC.obj)

   3. LINK TestABC,DecadasABC--------// Generación de imagen ejecutable (TestABC.exe)

   4. RUN TestABC

IDENTIFICATION DIVISION.
*-----------------------
PROGRAM-ID.		DecadasABC.
AUTHOR.			Eduardo Navarro P. (1998)
*
*	Subprograma para transformar fechas del formato AAMMDD
*	al formato AAAAMMDD y viceversa.
*
*	Opera como un objeto (DecadasABC.obj) llamado desde un programa principal.
*	Tiene como argumentos los valores Fecha6, Fecha8 y AAAAinferior (año inferior).
*
*	Recibe Fecha6 o Fecha8 (sólo uno de ellos, el otro debe ser igual a SPACES)
*	El valor de retorno al programa llamador queda en Fecha8 o Fecha6 según corresponda.
*
*	En valor AAAAinferior se utiliza sólo en la conversión de 6 a 8 caracteres,
*	con el fin de actuar como referencia para interpretar fechas de 6 caracteres
*	numéricos, como del siglo actual o como del próximo.
*

ENVIRONMENT DIVISION.
*-------------------

DATA DIVISION.
*------------

WORKING-STORAGE SECTION.
*-----------------------
01 Varios.
	05 i				PIC 9(02).
	05 SigloDecadaAux		pic 9(02).
	05 nada				pic 9(01).
	05 Decadas2000			pic x(26).
	05 TabDecada redefines decadas2000.
	   10 T_Decada occurs 26 times	pic x(01).

LINKAGE SECTION.
*--------------
01 Fecha6.
   05 aa6.
      10 Decada6		pic x(01).	
      10 a6				pic 9(01).	
   05 mm6			pic 9(02).
   05 dd6			pic 9(02).
01 Fecha8.
   05 aaaa8.
      10 Milenio8		pic 9(01).
      10 SigloDecada8.
          15 Siglo8		pic 9(01).
          15 Decada8		pic 9(01).
      10 a8				pic 9(01).
   05 mm8			pic 9(02).
   05 dd8			pic 9(02).
01 AAAAinferior			PIC 9(04).

PROCEDURE DIVISION using Fecha6, Fecha8, AAAAinferior.
*-----------------

Inicio.
	if (Fecha6 > spaces and Fecha8 > space ) or
	   (Fecha6 not > space and Fecha8 not > spaces) then
		go to Formato
	end-if	
 	if Fecha6 > spaces then
		perform De6a8
	else
		perform De8a6
	end-if

	display "Fecha6:   [" Fecha6 "]"
	display "Fecha8:   [" Fecha8 "]"
*	display " "
	go to Fin.

De6a8.
*-----
	move "ABCDEFGHIJKLMNOPQRSTUVWXYZ" to Decadas2000
	if Decada6 > "9" then
		perform varying i from 1 by 1 until Decada6 = T_Decada(i) or i > 26
			move 0 to nada
		end-perform
*	       Si no acierta intenta con minúsculas
		if  i > 26 then
			move "abcdefghijklmnopqrstuvwxyz" to Decadas2000
			perform varying i from 1 by 1 until Decada6 = T_Decada(i) or i > 26
				move 0 to nada
			end-perform
*		       Si se informa década en minúscula la transforma a mayúscula
			if i < 27 then
				move "ABCDEFGHIJKLMNOPQRSTUVWXYZ" to Decadas2000
				move T_Decada(i) to Decada6
			end-if

		end-if
		if i < 27 then
			move "2" 	to Milenio8
			subtract 1 from i giving SigloDecadaAux
			move SigloDecadaAux to SigloDecada8
			move a6	to a8
*	      Si no acierta una década asume "19xx"
		else
			move "1" 	to Milenio8
			move "9" 	to Siglo8
			move Decada6	to Decada8
			move a6	to a8
		end-if
	else
		move "1" 	to Milenio8
		move "9" 	to Siglo8
		move Decada6	to Decada8
		move a6	to a8
	end-if
	move mm6	to mm8
	move dd6	to dd8
*     Si año obtenido es menor que AAAAinferior asume milenio = "2"
	if aaaa8 < AAAAinferior	then
		move "2" 	to Milenio8
		move "0" 	to Siglo8
		perform De8a6
	end-if.

De8a6.
*-----
	move "ABCDEFGHIJKLMNOPQRSTUVWXYZ" to Decadas2000
	if aaaa8 > "1999" and aaaa8 not > "2259" then
		Move SigloDecada8		  to SigloDecadaAux
		move T_Decada(SigloDecadaAux + 1) to Decada6
		move a8			  to a6
	else
		if aaaa8 < "2000" and aaaa8 not < "1900" then
			move Decada8	to Decada6
			move a8	to a6
		else
			move "?" 	to Decada6
			move a8	to a6
		end-if
	end-if
	move mm8 to mm6
	move dd8 to dd6.

Formato.
	Display ' '
	Display 'Formato:'
	Display 'WORKING-STORAGE SECTION.'
	Display '01 Varios'
 	Display '	05 Fecha6.'
 	Display '	   10 AA		PIC X(02).'
	Display '	   10 MM6		PIC 9(02).'
	Display '	   10 DD6		PIC 9(02).'
	Display '	05 Fecha8.'
	Display '	   10 AAAA		PIC 9(04).'
	Display '	   10 MM8		PIC 9(02).'
	Display '	   10 DD8		PIC 9(02).'
	Display '	05 Inferior		PIC 9(04).'
	Display '...'
	Display 'PROCEDURE DIVISION.'
	Display '...'
	Display '...'
	Display '*	Debe informarse sólo Fecha6 o sólo Fecha8'
	Display '		Move spaces	to Fecha8.'
	Display '		Move "031016"	to Fecha6.'
	Display '* o bien	Move "A31016" to Fecha6. (en este caso no se requiere Año Inferior)' 
	Display '		Move "1930"	to Inferior.'
	Display '		CALL "DecadasABC" USING BY REFERENCE'
	Display '		         Fecha6, Fecha8, Inferior'
	Display '...'
	Display '...'
	Display ' '
	go to Fin.

Fin.
*===
	exit program.

Otro Código Fuente Disponible

| Cobol (TestABC) | DEC Basic (DecadasABC) | JavaScript |

Volver a Página Principal