Código de Cobol - RUTINA DE MONTO ESCRITO

Imágen de perfil
Val: 25
Ha aumentado 1 puesto en Cobol (en relación al último mes)
Gráfica de Cobol

RUTINA DE MONTO ESCRITOgráfica de visualizaciones


Cobol

Publicado el 3 de Noviembre del 2014 por Sergio (2 códigos)
8.078 visualizaciones desde el 3 de Noviembre del 2014
Hola, comparto con ustedes un programa COBOL que traduce un monto en números a su correspondiente monto escrito. Ejemplo:

Monto Numerico: 360321, 98
Monto Escrito : TRESCIENTOS SESENTA MIL TRESCIENTOS VEINTIUNO CON 98 CTVOS

Soporta hasta 999 miles de millones y devuelve un texto de 170 caracteres que pueden usar como mejor les convenga (separa en dos o más lineas).

Espero les sea de utilidad.

Saludos,


Sergio

1.00
estrellaestrellaestrellaestrellaestrella(15)

Publicado el 3 de Noviembre del 2014gráfica de visualizaciones de la versión: 1.00
8.079 visualizaciones desde el 3 de Noviembre del 2014
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
IDENTIFICATION DIVISION.
       PROGRAM-ID. MONES.
       DATE-WRITTEN. 31-10-2014.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM-AT.
       OBJECT-COMPUTER. IBM-AT.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  VARIABLES.
           02 FRASE	PIC X(15).
           02 FW REDEFINES FRASE OCCURS 15 TIMES PIC X.
           02 TODO	PIC 999.
           02 TODOX REDEFINES TODO.
              03 A	PIC 9.
              03 B	PIC 9.
              03 C	PIC 9.
           02 TODO-X REDEFINES TODO.
              03 FILLER PIC X.
              03 DOS	PIC 99.
           02 VER-VAL   PIC 9(12)V99.
           02 VERVAL REDEFINES VER-VAL.
              03 MILMILLON PIC 999.
              03 MILLON	PIC 999.
              03 MILCIEN.
                 04 MILES	PIC 999.
                 04 CIEN	PIC 999.
              03 CHIVOS	PIC 99.
           02 CENTAVOS.
              03 FILLER	PIC X(4) VALUE "CON".
              03 CTAVOS	PIC 99.
              03 FILLER PIC X(8) VALUE " CTVOS*".
           02 UNO PIC X(4) VALUE "UNO*".
           02 I	PIC 999 VALUE 0.
           02 J PIC 999 VALUE 0.
           02 K PIC 999 VALUE 0.
           02 L PIC 999	VALUE 0.
           02 M PIC 999 VALUE 0.
           02 S PIC 9 VALUE 0.
           02 P PIC 9 VALUE 0.
           02 sn pic x.
           02 NOM-VALORES.
              03 FILLER PIC X(15) VALUE "UN*".
              03 FILLER PIC X(15) VALUE "DOS*".
              03 FILLER PIC X(15) VALUE "TRES*".
              03 FILLER PIC X(15) VALUE "CUATRO*".
              03 FILLER PIC X(15) VALUE "CINCO*".
              03 FILLER PIC X(15) VALUE "SEIS*".
              03 FILLER PIC X(15) VALUE "SIETE*".
              03 FILLER PIC X(15) VALUE "OCHO*".
              03 FILLER PIC X(15) VALUE "NUEVE*".
              03 FILLER PIC X(15) VALUE "DIEZ*".
              03 FILLER PIC X(15) VALUE "ONCE*".
              03 FILLER PIC X(15) VALUE "DOCE*".
              03 FILLER PIC X(15) VALUE "TRECE*".
              03 FILLER PIC X(15) VALUE "CATORCE*".
              03 FILLER PIC X(15) VALUE "QUINCE*".
              03 FILLER PIC X(15) VALUE "DIECISEIS*".
              03 FILLER PIC X(15) VALUE "DIECISIETE*".
              03 FILLER PIC X(15) VALUE "DIECIOCHO*".
              03 FILLER PIC X(15) VALUE "DIECINUEVE*".
              03 FILLER PIC X(15) VALUE "VEINTE*".
              03 FILLER PIC X(15) VALUE "VEINTI*".
              03 FILLER PIC X(15) VALUE "TREINTA*".
              03 FILLER PIC X(15) VALUE "CUARENTA*".
              03 FILLER PIC X(15) VALUE "CINCUENTA*".
              03 FILLER PIC X(15) VALUE "SESENTA*".
              03 FILLER PIC X(15) VALUE "SETENTA*".
              03 FILLER PIC X(15) VALUE "OCHENTA*".
              03 FILLER PIC X(15) VALUE "NOVENTA*".
              03 FILLER PIC X(15) VALUE "CIEN*".
              03 FILLER PIC X(15) VALUE "CIENTO*".
              03 FILLER PIC X(15) VALUE "DOSCIENTOS*".
              03 FILLER PIC X(15) VALUE "TRESCIENTOS*".
              03 FILLER PIC X(15) VALUE "CUATROCIENTOS*".
              03 FILLER PIC X(15) VALUE "QUINIENTOS*".
              03 FILLER PIC X(15) VALUE "SEISCIENTOS*".
              03 FILLER PIC X(15) VALUE "SETECIENTOS*".
              03 FILLER PIC X(15) VALUE "OCHOCIENTOS*".
              03 FILLER PIC X(15) VALUE "NOVECIENTOS*".
           02 NOM-VAL REDEFINES NOM-VALORES PIC X(15) OCCURS 38 TIMES.
       LINKAGE SECTION.
       01 LS-DATOS.
        02 VALOR	PIC 9(12)V99.
        02 MONTO-LETRAS PIC X(170).
        02 LINEA REDEFINES MONTO-LETRAS PIC X OCCURS 170.
       PROCEDURE DIVISION USING LS-DATOS.
 
       INICIO SECTION.
       01. INITIALIZE VER-VAL FRASE MONTO-LETRAS.
           MOVE VALOR TO VER-VAL IF VER-VAL > 0
             PERFORM PROCESO.
       90. EXIT PROGRAM.
           STOP RUN.
 
       PROCESO SECTION.
       01. MOVE 1 TO K MOVE 0 TO S
      *miles de millones
           MOVE 1 TO P.
           IF MILMILLON > 0 MOVE MILMILLON TO TODO
              PERFORM LLENAR
              MOVE "MIL*" TO FRASE
              PERFORM LETRAS
              MOVE "MILLONES*" TO FRASE
              PERFORM LETRAS.
      *millones
           MOVE 2 TO P.
           IF MILLON > 0 MOVE MILLON TO TODO
              PERFORM LLENAR
              IF MILLON = 1 AND MILMILLON = 0 MOVE "MILLON*" TO FRASE
              ELSE MOVE "MILLONES*" TO FRASE
              END-IF
              PERFORM LETRAS.
      *miles
           MOVE 3 TO P.
           IF MILES > 0 MOVE MILES TO TODO
              PERFORM LLENAR
              MOVE "MIL*" TO FRASE
              PERFORM LETRAS.
      *cientos / unidades
           MOVE 4 TO P.
           MOVE CIEN TO TODO.
           PERFORM LLENAR.
      *decimales.
           MOVE 5 TO P.
           MOVE 0 TO TODO, PERFORM LLENAR.
       90. EXIT.
 
       LLENAR SECTION.
       01. IF TODO = 0
            IF P = 5
             IF CHIVOS > 0 MOVE CHIVOS TO CTAVOS
               MOVE CENTAVOS TO FRASE
               PERFORM LETRAS go 90
             else go 90
            else go 90.
      *si A > 0 posiciona el indice L en "ciento" (29)
           IF A > 0 MOVE 29 TO L
              IF DOS > 0 ADD A TO L MOVE NOM-VAL (L) TO FRASE
              ELSE
              IF A > 1 ADD A TO L MOVE NOM-VAL (L) TO FRASE
              ELSE MOVE NOM-VAL (L) TO FRASE.
           PERFORM LETRAS.
           IF DOS = 0 GO 90.
           IF DOS < 21 MOVE NOM-VAL (DOS) TO FRASE
              PERFORM LETRAS GO 90.
           IF B = 2 MOVE 21 TO L MOVE NOM-VAL (L) TO FRASE
           ELSE MOVE 19 TO L ADD B TO L MOVE NOM-VAL (L) TO FRASE.
           PERFORM LETRAS.
           IF B > 2 IF C > 0 MOVE "Y*" TO FRASE
              PERFORM LETRAS.
           IF C > 0 MOVE NOM-VAL (C) TO FRASE
              PERFORM LETRAS.
       90. Exit.
 
       LETRAS SECTION.
       01. if frase = spaces go 90.
           IF P = 4 AND FRASE = "UN*" MOVE UNO TO FRASE.
           STRING FRASE DELIMITED BY "*" INTO MONTO-LETRAS POINTER K.
           STRING " " DELIMITED BY SIZE INTO MONTO-LETRAS POINTER K.
           IF FRASE = "VEINTI*" SUBTRACT 1 FROM K.
           INITIALIZE FRASE.
       90. exit.



Comentarios sobre la versión: 1.00 (15)

Imágen de perfil
8 de Julio del 2015
estrellaestrellaestrellaestrellaestrella
FANTASTICO... AGRADECIDO.
Responder
Imágen de perfil
23 de Mayo del 2016
estrellaestrellaestrellaestrellaestrella
Estimado.
Podrias ayudarme; necesito convertir mis programas cobol de 32 bit a 64...!
donde puedo comprar el nuevo compilador,
agradecido.
Responder
Imágen de perfil
5 de Marzo del 2017
estrellaestrellaestrellaestrellaestrella
De nada Jorge, me alegra que te haya servido.
Responder
johana
17 de Septiembre del 2019
estrellaestrellaestrellaestrellaestrella
Hola me podrias apoyar en explicarme como saco el monto y los centavos sobre 100
Responder
Alex,
4 de Marzo del 2017
estrellaestrellaestrellaestrellaestrella
Increible. Esa rutina es la misma que yo usaba en 1980 cuando aprendi COBOL. No tiene ni una coma ma s ni una coma menos. 37 años y la rutina sigue campante. INCREIBLE
Responder
Imágen de perfil
5 de Marzo del 2017
estrellaestrellaestrellaestrellaestrella
Si es una rutina que si esta bien programada no hay porque tocarla, saludos Alex
Responder
18 de Junio del 2017
estrellaestrellaestrellaestrellaestrella
SALUDOS SERGIO, TREMENDO PROGRAMA. DE MUCHA AYUDA, TRABAJA MUY BIEN
Responder
Imágen de perfil
19 de Junio del 2017
estrellaestrellaestrellaestrellaestrella
Omar, en buena hora que te haya sido de utilidad. Saludos
Responder
24 de Octubre del 2017
estrellaestrellaestrellaestrellaestrella
Esta buenísimo y reemplazo el mio.
Estoy necesitando los FDs de unas tablas de contabilidad.
del plan de cuentas, de movimientos y de los saldos.
Si puedes ayudarme te lo agradeceré mucho.
Quedo pendiente.
Responder
Imágen de perfil
25 de Octubre del 2017
estrellaestrellaestrellaestrellaestrella
Hola Hernan, me alegro que te haya servido este programa. En cuanto a las FD pasame mandame un correo al mail [email protected] y te paso lo que pueda tener.

Slds,
Responder
28 de Diciembre del 2017
estrellaestrellaestrellaestrellaestrella
Hola Hernan..!! Excelente aporte.. He podido mejorar la rutina que tenia...

Estoy necesitando urgentemente conseguir el instalable de microfocus cobol 84. Alguna sugerencia de como conseguirlo o lo tienes.?

Millón de gracias..


Saludos,

Sebastian.
Responder
Imágen de perfil
28 de Febrero del 2018
estrellaestrellaestrellaestrellaestrella
En COBOL se pueden crear formularios????
O sea controles e interfaces gráficas????
Responder
Gabriel
31 de Agosto del 2019
estrellaestrellaestrellaestrellaestrella
Cuando empece a estudiar Cobol, estudie la versión del MS-COBOL que tenia una sección llamada
SCREEN-SECTION.

En donde podías crear tus controles en el orden que deseabas y ponerles color a tu gusto.

Ahora bien existia tambien el RM-COBOL que no tenia esta opcion del SCREEN SECTION

Espéro te aclare un poco tu duda.

Saludos,

INTEGRAL
Responder
Imágen de perfil
28 de Julio del 2020
estrellaestrellaestrellaestrellaestrella
Buenos y simples los ejemplos.
Responder
Imágen de perfil
2 de Noviembre del 2022
estrellaestrellaestrellaestrellaestrella
Excelente
Responder

Comentar la versión: 1.00

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios...
CerrarCerrar
CerrarCerrar
Cerrar

Tienes que ser un usuario registrado para poder insertar imágenes, archivos y/o videos.

Puedes registrarte o validarte desde aquí.

Codigo
Negrita
Subrayado
Tachado
Cursiva
Insertar enlace
Imagen externa
Emoticon
Tabular
Centrar
Titulo
Linea
Disminuir
Aumentar
Vista preliminar
sonreir
dientes
lengua
guiño
enfadado
confundido
llorar
avergonzado
sorprendido
triste
sol
estrella
jarra
camara
taza de cafe
email
beso
bombilla
amor
mal
bien
Es necesario revisar y aceptar las políticas de privacidad

http://lwp-l.com/s2830