IDENTIFICATION DIVISION. PROGRAM-ID. LISTA-CLIENTES. REMARKS. EJEMPLO DE LISTADO DE UN ARCHIVO DE CLIENTES INDEXADOS. Se desea listar (por pantalla o impresora) el contenido de un archivo con el siguiente dise¤o. ARCHIVO DE CLIENTES. NUMERO DE CLIENTE 5 N. RAZON SOCIAL 30 AN. DIRECCION. CALLE 30 AN. NUMERO 5 N. LOCALIDAD 30 AN. CODIGO. PROVINCIA 1 N. ZONA DE VENTA 2 N. VENDEDOR 2 N. SALDO 10 N (8 ENTEROS 2 DECIMALES PUEDE TOMAR VALORES NEGATIVOS). Organizaci¢n: Indexado claves = n£mero de cliente (clave principal) raz¢n social (puede tener valores duplicados) y c¢digo (puede tener valores duplicados). NOTA: se listar  el contenido del archivo por pantalla o impresora, ordenado por n£mero de cliente o por c¢digo. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. PC. OBJECT-COMPUTER. PC. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT CLIENTES ASSIGN TO RANDOM "CLIENTES.DAT" ORGANIZATION IS INDEXED ACCESS IS SEQUENTIAL RECORD KEY IS NRO-CLIENTE ALTERNATE RECORD KEY IS RAZON-SOCIAL WITH DUPLICATES ALTERNATE RECORD KEY IS CODIGO WITH DUPLICATES. SELECT LISTADO ASSIGN TO PRINT "LISTA.TXT". DATA DIVISION. FILE SECTION. FD CLIENTES. 01 REG-CLIENTES. 03 NRO-CLIENTE. 05 NRO-CLI PIC 9(5). 03 RAZON-SOCIAL PIC X(30). 03 DIRECCION. 05 CALLE PIC X(30). 05 NRO PIC 9(5). 03 LOCALIDAD PIC X(30). 03 CODIGO. 05 PROVINCIA PIC 9. 05 ZONA-VENTA PIC 9(2). 05 VENDEDOR PIC 9(2). 03 SALDO PIC S9(8)V9(2). FD LISTADO LINAGE IS 58 WITH FOOTING AT 53 LINES AT TOP 4 LINES AT BOTTOM 4. 01 REG-LISTADO PIC X(80). WORKING-STORAGE SECTION. 01 AUXILIAR. 03 AUX-NRO-CLIENTE. 05 AUX-NRO-CLI PIC 9(5). 03 AUX-RAZON-SOCIAL PIC X(30). 03 AUX-DIRECCION. 05 AUX-CALLE PIC X(30). 05 AUX-NRO PIC 9(5). 03 AUX-LOCALIDAD PIC X(30). 03 AUX-CODIGO. 05 AUX-PROVINCIA PIC 9. 05 AUX-ZONA-VENTA PIC 9(2). 05 AUX-VENDEDOR PIC 9(2). 03 AUX-SALDO PIC ZZ.ZZZ.ZZ9,99DB. 01 DISPLAY-DETALLE-NRO. 03 PIC X(2) VALUE SPACES. 03 DISP-NRO PIC ZZ.ZZZ. 03 PIC X(5) VALUE SPACES. 03 DISP-RAZON PIC X(30). 03 PIC X(5) VALUE SPACES. 03 DISP-PROV PIC 9. 03 PIC X(5) VALUE SPACES. 03 DISP-ZONA PIC Z9. 03 PIC X(4) VALUE SPACES. 03 DISP-VEND PIC Z9. 03 PIC X(2) VALUE SPACES. 03 DISP-SALDO PIC ZZ.ZZZ.ZZ9,99DB. 03 PIC X(4) VALUE SPACES. 01 DISPLAY-DETALLE-COD. 03 PIC X(3) VALUE SPACES. 03 DISP-COD-PROV PIC 9. 03 PIC X(5) VALUE SPACES. 03 DISP-COD-ZONA PIC Z9. 03 PIC X(4) VALUE SPACES. 03 DISP-COD-VEND PIC Z9. 03 PIC X(4) VALUE SPACES. 03 DISP-COD-NRO PIC ZZ.ZZZ. 03 PIC X(4) VALUE SPACES. 03 DISP-COD-RAZON PIC X(30). 03 PIC X(2) VALUE SPACES. 03 DISP-COD-SALDO PIC ZZ.ZZZ.ZZ9,99DB. 03 PIC X(4) VALUE SPACES. 77 BASE PIC X(80) VALUE SPACES. 77 ASTERISCO PIC X(80) VALUE ALL "*". 77 OPCION PIC 9. 77 CONTINUA PIC A VALUE "S". 77 FIN PIC A VALUE "N". 77 SENIAL-1 PIC A VALUE "N". 77 SENIAL-2 PIC A VALUE "N". 77 SENIAL-3 PIC A VALUE "N". 77 LINEA PIC 99 VALUE 10. 77 INICIO-NUMERO PIC X(5) VALUE "00001". 77 INICIO-CODIGO PIC X(5) VALUE "10101". 01 TITULO-NRO. 03 PIC X(26) VALUE SPACES. 03 PIC X(27) VALUE "LISTADO DE ARCHIVO CLIENTES". 03 PIC X(27) VALUE SPACES. 01 SUBTITULO-NRO. 03 PIC X(2) VALUE SPACES. 03 PIC X(10) VALUE "N§ CLIENTE". 03 PIC X(11) VALUE SPACES. 03 PIC X(12) VALUE "RAZON SOCIAL". 03 PIC X(12) VALUE SPACES. 03 PIC X(5) VALUE "PROV.". 03 PIC X(2) VALUE SPACES. 03 PIC X(4) VALUE "ZONA". 03 PIC X(2) VALUE SPACES. 03 PIC X(5) VALUE "VEND.". 03 PIC X(5) VALUE SPACES. 03 PIC X(5) VALUE "SALDO". 01 SUBTITULO-LINEA PIC X(80) VALUE ALL "*". 01 SUBTITULO-COD. 03 PIC X(2) VALUE SPACES. 03 PIC X(5) VALUE "PROV.". 03 PIC X(2) VALUE SPACES. 03 PIC X(4) VALUE "ZONA". 03 PIC X(2) VALUE SPACES. 03 PIC X(5) VALUE "VEND.". 03 PIC X(1) VALUE SPACES. 03 PIC X(10) VALUE "N§ CLIENTE". 03 PIC X(10) VALUE SPACES. 03 PIC X(12) VALUE "RAZON SOCIAL". 03 PIC X(19) VALUE SPACES. 03 PIC X(5) VALUE "SALDO". SCREEN SECTION. 01 FONDO BACKGROUND IS WHITE, FOREGROUND IS BLUE. 03 LINE 4 COL 1 PIC X(80) USING BASE. 03 LINE 5 COL 1 PIC X(80) USING BASE. 03 LINE 6 COL 1 PIC X(80) USING BASE. 03 LINE 7 COL 1 PIC X(80) USING BASE. 03 LINE 8 COL 1 PIC X(80) USING BASE. 03 LINE 9 COL 1 PIC X(80) USING BASE. 03 LINE 10 COL 1 PIC X(80) USING BASE. 03 LINE 11 COL 1 PIC X(80) USING BASE. 03 LINE 12 COL 1 PIC X(80) USING BASE. 03 LINE 13 COL 1 PIC X(80) USING BASE. 03 LINE 14 COL 1 PIC X(80) USING BASE. 03 LINE 15 COL 1 PIC X(80) USING BASE. 03 LINE 16 COL 1 PIC X(80) USING BASE. 03 LINE 17 COL 1 PIC X(80) USING BASE. 03 LINE 18 COL 1 PIC X(80) USING BASE. 03 LINE 19 COL 1 PIC X(80) USING BASE. 03 LINE 20 COL 1 PIC X(80) USING BASE. 03 LINE 21 COL 1 PIC X(80) USING BASE. 01 MENU-PPAL BACKGROUND IS WHITE, FOREGROUND IS BLUE. 03 LINE 5 COL 26 VALUE "LISTADO DE ARCHIVO CLIENTES". 03 LINE 10 COL 10 VALUE "1 - SALIDA POR PANTALLA ORDENADA POR - " NUMERO DE CLIENTE". 03 LINE 12 COL 10 VALUE "2 - SALIDA POR IMPRESORA ORDENADA PO - "R NUMERO DE CLIENTE". 03 LINE 14 COL 10 VALUE "3 - SALIDA POR PANTALLA ORDENADA POR - " CODIGO". 03 LINE 16 COL 10 VALUE "4 - SALIDA POR IMPRESORA ORDENADA PO - "R CODIGO". 03 LINE 18 COL 10 VALUE "9 - SALIR". 03 LINE 20 COL 10 VALUE "INGRESE SU OPCION". 03 LINE 20 COL 30 PIC 9 USING OPCION. 01 FONDO-TITULO BACKGROUND IS WHITE, FOREGROUND IS BLUE. 03 LINE 4 COL 1 PIC X(80) USING BASE. 03 LINE 5 COL 1 PIC X(80) USING BASE. 03 LINE 6 COL 1 PIC X(80) USING BASE. 03 LINE 7 COL 1 PIC X(80) USING BASE. 03 LINE 8 COL 1 PIC X(80) USING BASE. 03 LINE 9 COL 1 PIC X(80) USING BASE. 01 DISPLAY-TITULO-NRO BACKGROUND IS WHITE, FOREGROUND IS BLUE. 03 LINE 5 COL 26 VALUE "LISTADO DE ARCHIVO CLIENTES". 03 LINE 7 COL 1 VALUE " N§ CLIENTE RAZON SOCIAL - " PROV. ZONA VEND. SALDO". 03 LINE 8 COL 1 PIC X(80) USING ASTERISCO. 01 DISPLAY-TITULO-COD BACKGROUND IS WHITE, FOREGROUND IS GREEN. 03 LINE 5 COL 26 VALUE "LISTADO DE ARCHIVO CLIENTES". 03 LINE 7 COL 1 VALUE " PROV. ZONA VEND. N§ CLIENTE - " RAZON SOCIAL SALDO". 03 LINE 8 COL 1 PIC X(80) USING ASTERISCO. PROCEDURE DIVISION. COMIENZO. OPEN I-O CLIENTES OUTPUT LISTADO. PERFORM UNTIL OPCION = 9 MOVE ZEROES TO OPCION DISPLAY SPACES ERASE CONTROL "FCOLOR = WHITE, BCOLOR = BLACK" DISPLAY FONDO DISPLAY MENU-PPAL ACCEPT MENU-PPAL END-ACCEPT DISPLAY SPACE ERASE EOL LINE 22 POSITION 2 CONTROL "FCOLOR = WHITE, BCOLOR = BLACK" DISPLAY MENU-PPAL EVALUATE OPCION WHEN 1 PERFORM PANTALLA-NUMERO WHEN 2 PERFORM IMPRESORA-NUMERO WHEN 3 PERFORM PANTALLA-CODIGO WHEN 4 PERFORM IMPRESORA-CODIGO WHEN 9 PERFORM SALIR WHEN OTHER DISPLAY "Ingrese un valor V lido" LINE 22 POSITION 23 CONTROL "FCOLOR = RED, BCOLOR = WHITE" END-EVALUATE END-PERFORM. STOP RUN. PANTALLA-NUMERO. DISPLAY SPACES ERASE CONTROL "FCOLOR = WHITE, BCOLOR = BLACK". DISPLAY FONDO-TITULO. DISPLAY DISPLAY-TITULO-NRO. * MOVE INICIO-CODIGO TO CODIGO. * START CLIENTES KEY IS EQUAL TO CODIGO. MOVE INICIO-NUMERO TO NRO-CLIENTE. START CLIENTES KEY IS GREATER THAN OR EQUAL TO NRO-CLIENTE. MOVE "N" TO FIN. MOVE "S" TO CONTINUA. MOVE 10 TO LINEA. PERFORM UNTIL CONTINUA = "N" ADD 1 TO LINEA END-ADD READ CLIENTES AT END MOVE "S" TO FIN NOT AT END MOVE NRO-CLI TO DISP-NRO MOVE RAZON-SOCIAL TO DISP-RAZON MOVE PROVINCIA TO DISP-PROV MOVE ZONA-VENTA TO DISP-ZONA MOVE VENDEDOR TO DISP-VEND MOVE SALDO TO DISP-SALDO DISPLAY DISPLAY-DETALLE-NRO LINE LINEA POSITION 1 CONTROL "FCOLOR = BLUE, BCOLOR = BLACK" END-READ IF LINEA = 20 MOVE "S" TO CONTINUA DISPLAY " Contin£a (S/N): " LINE 22 POSITION 32 CONTROL "FCOLOR = RED, BCOLOR = WHITE" DISPLAY CONTINUA LINE 22 POSITION 49 CONTROL "FCOLOR = RED, BCOLOR = WHITE" ACCEPT CONTINUA LINE 22 POSITION 49 UPDATE TAB CONTROL "FCOLOR = RED, BCOLOR = WHITE" END-ACCEPT IF CONTINUA = "S" MOVE 10 TO LINEA DISPLAY SPACES ERASE EOS LINE 9 POSITION 1 CONTROL "FCOLOR = WHITE, BCOLOR = BLACK" END-IF END-IF IF FIN = "S" MOVE "N" TO CONTINUA DISPLAY " Fin de Archivo Oprima una tecla para continuar - " " LINE 22 POSITION 17 CONTROL "FCOLOR = RED, BCOLOR = WHITE" ACCEPT CONTINUA LINE 22 POSITION 65 TAB CONTROL "FCOLOR = RED, BCOLOR = WHITE" END-ACCEPT MOVE "N" TO CONTINUA DISPLAY SPACES ERASE EOS LINE 9 POSITION 1 CONTROL "FCOLOR = WHITE, BCOLOR = BLACK" END-IF END-PERFORM. IMPRESORA-NUMERO. DISPLAY SPACES ERASE CONTROL "FCOLOR = WHITE, BCOLOR = BLACK". MOVE "S" TO CONTINUA MOVE INICIO-NUMERO TO NRO-CLIENTE. START CLIENTES KEY IS GREATER THAN OR EQUAL TO NRO-CLIENTE. READ CLIENTES AT END MOVE "N" TO CONTINUA NOT AT END MOVE NRO-CLI TO DISP-NRO MOVE RAZON-SOCIAL TO DISP-RAZON MOVE PROVINCIA TO DISP-PROV MOVE ZONA-VENTA TO DISP-ZONA MOVE VENDEDOR TO DISP-VEND MOVE SALDO TO DISP-SALDO END-READ. PERFORM IMPRE-TITULOS-NRO. PERFORM UNTIL CONTINUA = "N" WRITE REG-LISTADO FROM DISPLAY-DETALLE-NRO AFTER ADVANCING 1 LINE AT EOP PERFORM IMPRE-TITULOS-NRO END-WRITE READ CLIENTES AT END MOVE "N" TO CONTINUA NOT AT END MOVE NRO-CLI TO DISP-NRO MOVE RAZON-SOCIAL TO DISP-RAZON MOVE PROVINCIA TO DISP-PROV MOVE ZONA-VENTA TO DISP-ZONA MOVE VENDEDOR TO DISP-VEND MOVE SALDO TO DISP-SALDO END-READ END-PERFORM. PANTALLA-CODIGO. DISPLAY SPACES ERASE CONTROL "FCOLOR = WHITE, BCOLOR = BLACK". DISPLAY FONDO-TITULO. DISPLAY DISPLAY-TITULO-COD. MOVE INICIO-CODIGO TO CODIGO. START CLIENTES KEY IS GREATER THAN OR EQUAL TO CODIGO. MOVE "N" TO FIN. MOVE "S" TO CONTINUA. MOVE 10 TO LINEA. PERFORM UNTIL CONTINUA = "N" ADD 1 TO LINEA END-ADD READ CLIENTES AT END MOVE "S" TO FIN NOT AT END MOVE NRO-CLI TO DISP-COD-NRO MOVE RAZON-SOCIAL TO DISP-COD-RAZON MOVE PROVINCIA TO DISP-COD-PROV MOVE ZONA-VENTA TO DISP-COD-ZONA MOVE VENDEDOR TO DISP-COD-VEND MOVE SALDO TO DISP-COD-SALDO DISPLAY DISPLAY-DETALLE-COD LINE LINEA POSITION 1 CONTROL "FCOLOR = GREEN, BCOLOR = BLACK" END-READ IF LINEA = 20 MOVE "S" TO CONTINUA DISPLAY " Contin£a (S/N): " LINE 22 POSITION 32 CONTROL "FCOLOR = RED, BCOLOR = WHITE" DISPLAY CONTINUA LINE 22 POSITION 49 CONTROL "FCOLOR = RED, BCOLOR = WHITE" ACCEPT CONTINUA LINE 22 POSITION 49 UPDATE TAB CONTROL "FCOLOR = RED, BCOLOR = WHITE" END-ACCEPT IF CONTINUA = "S" MOVE 10 TO LINEA DISPLAY SPACES ERASE EOS LINE 9 POSITION 1 CONTROL "FCOLOR = WHITE, BCOLOR = BLACK" END-IF END-IF IF FIN = "S" MOVE "N" TO CONTINUA DISPLAY " Fin de Archivo Oprima una tecla para continuar - " " LINE 22 POSITION 17 CONTROL "FCOLOR = RED, BCOLOR = WHITE" ACCEPT CONTINUA LINE 22 POSITION 65 TAB CONTROL "FCOLOR = RED, BCOLOR = WHITE" END-ACCEPT MOVE "N" TO CONTINUA DISPLAY SPACES ERASE EOS LINE 9 POSITION 1 CONTROL "FCOLOR = WHITE, BCOLOR = BLACK" END-IF END-PERFORM. IMPRESORA-CODIGO. DISPLAY "PANTALLA CODIGO" LINE 22 POSITION 23 CONTROL "FCOLOR = CYAN, BCOLOR = WHITE". SALIR. DISPLAY SPACES ERASE CONTROL "FCOLOR = WHITE, BCOLOR = BLACK". CLOSE CLIENTES LISTADO. IMPRE-TITULOS-NRO. WRITE REG-LISTADO FROM TITULO-NRO AFTER ADVANCING PAGE. WRITE REG-LISTADO FROM SUBTITULO-NRO AFTER ADVANCING 3 LINES. WRITE REG-LISTADO FROM SUBTITULO-LINEA AFTER ADVANCING 1 LINES.