ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PC-IBM.
OBJECT-COMPUTER. PC-IBM.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
COPY EMPRESA.SEL. COPY MOVDEU.SEL. COPY CODICOMP.SEL.
COPY VENDEDOR.SEL. COPY CONDVTAS.SEL. COPY LOCALIDA.SEL.
COPY PROVIN.SEL. COPY ZONAS.SEL. COPY CLIENTES.SEL.
COPY PROVEDOR.SEL. COPY MARCAS.SEL. COPY RUBROS.SEL.
COPY ARTICULO.SEL. COPY TRANSPOR.SEL.
COPY PROVCOMI.SEL. COPY RUBRCOMI.SEL.
SELECT AAAA ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS AA-CLAVE = AA-CODI
AA-ORDE
ALTERNATE RECORD KEY IS AA-CLAVE1 = AA-DESC
AA-CODI
AA-ORDE
WITH DUPLICATES
ALTERNATE RECORD KEY IS AA-CLAVE2 = AA-CANT
AA-CODI
AA-ORDE
WITH DUPLICATES
ALTERNATE RECORD KEY IS AA-CLAVE3 = AA-IMPO
AA-CODI
AA-ORDE
WITH DUPLICATES
FILE STATUS IS FF.
SELECT BBBB ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS BB-CLAVE = BB-CODI
BB-CODI2
ALTERNATE RECORD KEY IS BB-CLAVE1 = BB-DESC
BB-CODI
BB-DESC2
BB-CODI2
WITH DUPLICATES
ALTERNATE RECORD KEY IS BB-CLAVE2 = BB-CODI
BB-CANT2
BB-CODI2
WITH DUPLICATES
ALTERNATE RECORD KEY IS BB-CLAVE3 = BB-CODI
BB-IMPO2
BB-CODI2
WITH DUPLICATES
FILE STATUS IS FF.
SELECT CCCC ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS CC-CLAVE = CC-CODI
CC-ORDE
FILE STATUS IS FF.
SELECT TXT1 ASSIGN TO DISK
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FF.
SELECT TXT2 ASSIGN TO DISK
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FF.
SELECT IMPRES ASSIGN TO "C:TEMPESTAVTAS"
FILE STATUS IS FF.
COPY MOVOBA00.SEL.
COPY MOVOBA02.SEL.
*±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
DATA DIVISION.
FILE SECTION.
COPY EMPRESA.REC. COPY MOVDEU.REC. COPY CODICOMP.REC.
COPY VENDEDOR.REC. COPY CONDVTAS.REC. COPY LOCALIDA.REC.
COPY PROVIN.REC. COPY ZONAS.REC. COPY CLIENTES.REC.
COPY PROVEDOR.REC. COPY MARCAS.REC. COPY RUBROS.REC.
COPY ARTICULO.REC. COPY TRANSPOR.REC.
COPY PROVCOMI.REC. COPY RUBRCOMI.REC.
FD AAAA
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "C:TEMPAAAA.DAT".
01 R-AAAA.
02 AA-ORDE PIC 9(01).
02 AA-CODI PIC X(14).
02 AA-DESC PIC X(50).
02 AA-CANT PIC S9(05)V999.
02 AA-IMPO PIC S9(10)V99.
02 AA-COST PIC S9(10)V99.
opci 02 AA-PCOM PIC 9(03)V99.
opci 02 AA-ICOM PIC S9(10)V99.
02 AA-COST-SF PIC S9(10)V99.
FD BBBB
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "C:TEMPBBBB.DAT".
01 R-BBBB.
02 BB-CODI PIC X(14).
02 BB-DESC PIC X(50).
02 BB-CANT PIC S9(05)V999.
02 BB-IMPO PIC S9(10)V99.
02 BB-COST PIC S9(10)V99.
opci 02 BB-PCOM PIC 9(03)V99.
opci 02 BB-ICOM PIC S9(10)V99.
02 BB-CODI2 PIC X(14).
02 BB-DESC2 PIC X(50).
02 BB-CANT2 PIC S9(05)V999.
02 BB-IMPO2 PIC S9(10)V99.
02 BB-COST2 PIC S9(10)V99.
opci 02 BB-PCOM2 PIC 9(03)V99.
opci 02 BB-ICOM2 PIC S9(10)V99.
02 BB-COST-SF PIC S9(10)V99.
02 BB-COST2-SF PIC S9(10)V99.
FD CCCC
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "C:TEMPCCCC.DAT".
01 R-CCCC.
02 CC-ORDE PIC 9(01).
02 CC-CODI PIC X(14).
02 CC-DESC PIC X(50).
02 CC-CANT PIC S9(05)V999.
02 CC-IMPO PIC S9(10)V99.
FD TXT1
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "C:TEMPESTAVTAS".
01 R-TXT1.
02 X1-LONG PIC X(159).
FD TXT2
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "C:TEMPESTAVTAS.XLS".
01 R-TXT2.
02 X2-LONG.
* 03 X2-01 PIC X.
* 03 X2-ORDE PIC X(04).
* 03 X2-02 PIC X.
* 03 X2-CODI PIC X(14).
* 03 X2-03 PIC X.
* 03 X2-DESC PIC X(50).
* 03 X2-04 PIC X.
* 03 FILLER PIC X(31).
* 03 X2-05 PIC X.
* 03 X2-COST PIC 999,999,999.99-.
* 03 X2-06 PIC X.
* 03 X2-CANT PIC 99999-.
* 03 X2-07 PIC X.
* 03 X2-IMPO PIC 999,999,999.99-.
* 03 X2-08 PIC X.
* 03 X2-PORC PIC 999.99-.
* 03 X2-09 PIC X.
* 03 FILLER PIC X(10).
03 X2-ORDE PIC X(04).
03 X2-01 PIC X.
03 X2-CODI PIC X(14).
03 X2-02 PIC X.
03 X2-DESC PIC X(50).
03 X2-03 PIC X.
03 FILLER PIC X(08).
03 X2-04 PIC X.
opci 03 X2-PCOM PIC 999.99.
03 X2-05 PIC X.
opci 03 X2-ICOM PIC 999,999,999.99-.
03 X2-06 PIC X.
03 X2-COST PIC 999,999,999.99-.
03 X2-07 PIC X.
03 X2-CANT PIC 99999-.
03 X2-08 PIC X.
03 X2-IMPO PIC 999,999,999.99-.
03 X2-09 PIC X.
03 X2-PORC PIC 999.99-.
03 X2-10 PIC X.
03 FILLER PIC X(10).
FD IMPRES
LABEL RECORD IS OMITTED
LINAGE IS 66 LINES.
01 R-IMPRES PIC X(159).
*ESPE* VERTICAL...
*ESPE* 63 lineas - 79 columnas - 80 comando
*ESPE* 77 lineas - 95 columnas - 96 comando
*ESPE* 96 lineas - 129 columnas - 120 comando
*ESPE* 110 lineas - 136 columnas - 140 comando
*ESPE* 129 lineas - 159 columnas - 160 comando
*ESPE* HORIZONTAL...
*ESPE* 68 lineas - 159 columnas - 120 comando
*ESPE* 00 lineas - 000 columnas - 140 comando
*ESPE* 86 lineas - 225 columnas - 160 comando
COPY MOVOBA00.REC.
COPY MOVOBA02.REC.
WORKING-STORAGE SECTION.
Status 01 FF PIC XX.
" 88 FF-POS VALUE "00" "02" "10" "22" "23" "9A" "9D".
" 88 FF-OK VALUE "00" "02". 88 FF-FIN VALUE "10".
" 88 FF-DUP VALUE "22". 88 FF-INE VALUE "23".
" 88 FF-ALU VALUE "9A". 88 FF-RLU VALUE "9D".
" 01 M-ARC PIC X(08). 01 M-ERR PIC X(30).
Teclas 01 TEC PIC XX.
" 88 T-POS VALUE "00" "01" "02" "05" "53" "54".
" 88 T-RET VALUE "00". 88 T-ESC VALUE "01". 88 T-F1 VALUE "02".
" 88 T-ARR VALUE "53". 88 T-ABA VALUE "54". 88 T-F4 VALUE "05".
FunTec 01 Z-CAR PIC 9(2) COMP-X.
" 01 Z-STA.
" 02 Z-STA1 PIC X.
" 02 Z-STA2 PIC 9(2) COMP-X.
" 02 Z-STA3 PIC 9(2) COMP-X.
| 01 Z-FUN PIC 9(02) COMP-X. 01 Z-PAR. 03 Z-LON PIC 9(04) COMP-X.
| 03 Z-POS PIC 9(04) COMP-X. 03 Z-BAF PIC 9(04) COMP-X.
| 01 Z-CARA PIC X(2000). 01 Z-ATRI PIC X(2000).
| 01 Z-CARA1 PIC X(2000). 01 Z-ATRI1 PIC X(2000).
01 A-FECHA. 03 A-DIA PIC 99. 03 A-MES PIC 99. 03 A-ANO PIC 9999.
01 A-FECHAX REDEFINES A-FECHA PIC 9(08).
01 W-FECHA. 03 W-ANO PIC 9999. 03 W-MES PIC 99. 03 W-DIA PIC 99.
01 W-FECHAX REDEFINES W-FECHA PIC 9(08).
01 Z-FECHA. 03 Z-ANO PIC 99. 03 Z-MES PIC 99. 03 Z-DIA PIC 99.
01 FEC PIC 9(8). 01 FEC1 PIC 9(8). 01 FEC2 PIC 9(8).
01 HOR. 03 HOR1 PIC 99. 03 HOR2 PIC 99. 03 HOR3 PIC 99.
01 HORX REDEFINES HOR PIC 9(06).
01 X PIC 9(1). 01 X1 PIC 9(1). 01 X2 PIC 9(1). 01 X3 PIC 9(1).
01 OPC PIC 9(2). 01 MENS1 PIC X(12). 01 MENS2 PIC X(12).
N4 01 D-CODI PIC X(14). 01 H-CODI PIC X(14). 01 MENS3 PIC X(12).
N4 01 D-CODI1 PIC 9(04). 01 H-CODI1 PIC 9(04). 01 COIM PIC 9(4).
N6 01 D-CODI2 PIC 9(06). 01 H-CODI2 PIC 9(06). 01 FEIM PIC 9(8).
A14 01 D-CODI3 PIC X(14). 01 H-CODI3 PIC X(14). 01 ESTA PIC 9.
01 D-FECH PIC 9(08). 01 H-FECH PIC 9(08). 01 COMI PIC 9.
01 D-FECH1 PIC 9(08). 01 H-FECH1 PIC 9(08). 01 TODO PIC X.
01 ORDE PIC 9. 01 MODO PIC 9. 01 VIST PIC 9. 01 BAN PIC 9.
01 D-FE PIC 9(8). 01 H-FE PIC 9(8). 01 XORD PIC 9. 01 BAN2 PIC 9.
01 EMP PIC X(30). 01 DOM PIC X(30). 01 XORDX PIC 9.
01 SEN PIC 9. 01 PAG PIC 9(4). 01 MEMOCL PIC X(100).
01 CORT PIC X(14). 01 CORTX PIC X(50). 01 COSF PIC 9.
01 SINO PIC X(01). 88 POSI VALUE "S" "s" "N" "n".
88 SISI VALUE "S" "s". 88 NONO VALUE "N" "n".
01 ZZ-RES PIC 9(02) COMP-X. 01 ZZ-FUN PIC 9(02) COMP-X VALUE 35.
01 ZZ-PAR. 03 ZZ-PAR1 PIC 9(02) COMP-X VALUE 0. 03 ZZ-PAR2 PIC X.
MesAct 01 TOT-CANT PIC S9(06)V999. 01 TOT-IMPO PIC S9(10)V99 .
01 TOT-COST PIC S9(10)V99 .
01 TOT-ICOM PIC S9(10)V99 .
01 TOT-COST-SF PIC S9(10)V99 .
MesAnt 01 TOT-CANTT PIC S9(06)V999. 01 TOT-IMPOO PIC S9(10)V99 .
01 TOT-COSTT PIC S9(10)V99 .
01 TOT-ICOMM PIC S9(10)V99 .
01 TOT-COSTT-SF PIC S9(10)V99 .
MesAct 01 TOT1-CANT PIC S9(06)V999. 01 TOT1-IMPO PIC S9(10)V99.
01 TOT1-COST PIC S9(10)V99.
01 TOT1-ICOM PIC S9(10)V99.
01 TOT1-COST-SF PIC S9(10)V99.
MesAnt 01 TOT1-CANTT PIC S9(06)V999. 01 TOT1-IMPOO PIC S9(10)V99.
01 TOT1-COSTT PIC S9(10)V99.
01 TOT1-ICOMM PIC S9(10)V99.
01 TOT1-COSTT-SF PIC S9(10)V99.
MesAct 01 TOT2-CANT PIC S9(06)V999. 01 TOT2-IMPO PIC S9(10)V99.
01 TOT2-COST PIC S9(10)V99.
01 TOT2-ICOM PIC S9(10)V99.
01 TOT2-COST-SF PIC S9(10)V99.
MesAnt 01 TOT2-CANTT PIC S9(06)V999. 01 TOT2-IMPOO PIC S9(10)V99.
01 TOT2-COSTT PIC S9(10)V99.
01 TOT2-ICOMM PIC S9(10)V99.
01 TOT2-COSTT-SF PIC S9(10)V99.
01 CANITE PIC 9(6). 01 CANITET PIC 9(6).
01 AUX PIC S9(10)V99. 01 AUX1 PIC S9(10)V99.
01 AUX2 PIC S9(10)V99. 01 AUX3 PIC S9(10)V99.
01 AUX4 PIC S9(10)V99. 01 AUX5 PIC S9(10)V99.
01 COM1 PIC 9(3)V99. 01 COM2 PIC 9(3)V99. 01 COM3 PIC 9(3)V99.
01 PCLI PIC 9(4). 01 ZCLI PIC ZZZ9. 01 PORC PIC S9(3)V99.
01 PPED PIC 9(4). 01 ZPED PIC ZZZ9.
01 PCAM PIC 9(3)V99. 01 ZCAM PIC ZZ9.99.
01 PREI PIC 9(3)V99. 01 ZREI PIC ZZ9.99.
01 G1-IMPO PIC S9(10)V99. 01 G1-IMPOO PIC S9(10)V99.
01 G2-IMPO PIC S9(10)V99. 01 G2-IMPOO PIC S9(10)V99.
01 G3-IMPO PIC S9(10)V99. 01 G3-IMPOO PIC S9(10)V99.
01 Z1-IMPO PIC S9(10)V99. 01 Z1-IMPOO PIC S9(10)V99.
01 Z2-IMPO PIC S9(10)V99. 01 Z3-IMPO PIC S9(10)V99.
01 OBRA PIC 9. 01 OBRA2 PIC 9.
01 X-VEND PIC 9(4). 01 X-VENDX PIC X(30). 01 X-VENDZ PIC 9(3)V99.
01 X-COND PIC 9(04). 01 X-CONDX PIC X(30).
01 X-LOCA PIC 9(06). 01 X-LOCAX PIC X(30).
01 X-PCIA PIC 9(04). 01 X-PCIAX PIC X(30).
01 X-ZONA PIC 9(04). 01 X-ZONAX PIC X(30).
01 X-CLIE PIC 9(04). 01 X-CLIEX PIC X(30).
01 X-PROV PIC 9(04). 01 X-PROVX PIC X(30).
01 X-MARC PIC 9(04). 01 X-MARCX PIC X(30).
01 X-RUBR PIC 9(04). 01 X-RUBRX PIC X(30).
01 X-ARTI PIC X(14). 01 X-ARTIX PIC X(30).
01 X-CANT PIC 9(05)V999. 01 X-IMPO PIC 9(10)V99.
01 X-TIVA PIC 9(03)V99. 01 X-COST PIC 9(10)V99.
INI.
OPEN INPUT EMPRESA . MOVE "EMPRESA " TO M-ARC.
IF NOT FF-OK PERFORM VER-ERR GO FIN.
MOVE EM TO E-CLAVE. READ EMPRESA .
IF NOT FF-OK PERFORM VER-ERR CLOSE EMPRESA GO FIN.
MOVE E-RAZON TO EMP. MOVE E-DOMICI TO DOM.
MOVE E-FECHA TO FEC A-FECHA.
MOVE A-DIA TO W-DIA. MOVE A-MES TO W-MES.
MOVE A-ANO TO W-ANO. MOVE W-FECHAX TO FEC1.
CLOSE EMPRESA .
MOVE 01 TO OPC.
Opci INA.
MOVE 99 TO TEC. DISPLAY P-OPC.
IF OPC = 01 DISPLAY P-OPC01. IF OPC = 02 DISPLAY P-OPC02.
IF OPC = 03 DISPLAY P-OPC03. IF OPC = 04 DISPLAY P-OPC04.
IF OPC = 05 DISPLAY P-OPC05. IF OPC = 06 DISPLAY P-OPC06.
IF OPC = 07 DISPLAY P-OPC07. IF OPC = 08 DISPLAY P-OPC08.
IF OPC = 09 DISPLAY P-OPC09. IF OPC = 10 DISPLAY P-OPC10.
PERFORM LEO-TEC UNTIL T-POS. IF T-ESC GO FIN.
IF T-ABA IF OPC = 10 GO INA ELSE ADD 1 TO OPC GO INA.
IF T-ARR IF OPC = 01 GO INA ELSE SUBTRACT 1 FROM OPC GO INA.
IF NOT T-RET GO INA.
MOVE SPACES TO D-CODI H-CODI .
MOVE ZEROS TO D-CODI1 H-CODI1.
adic MOVE ZEROS TO D-CODI2 H-CODI2.
adic MOVE SPACES TO D-CODI3 H-CODI3.
MOVE FEC TO D-FECH H-FECH .
MOVE ZEROS TO D-FECH1 H-FECH1. MOVE SPACES TO TODO.
MOVE 0 TO ORDE MODO COSF VIST X COMI OBRA OBRA2.
INA0.
PERFORM 0S.
MOVE "Articulos " TO MENS1.
Codi INA1.
MOVE ZEROS TO TEC. DISPLAY P-CODI . ACCEPT P-CODI .
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC PERFORM 0N GO INA.
IF T-F1
CALL "AYUDARTI" USING ENLACE, D-CODI
CANCEL "AYUDARTI" MOVE ZEROS TO TEC
MOVE D-CODI TO H-CODI GO INA1.
IF NOT T-RET GO INA1.
IF D-CODI = SPACES
IF H-CODI = SPACES
MOVE "* " TO D-CODI
MOVE "ZZZZZZZZZZZZZZ" TO H-CODI .
IF H-CODI = SPACES
MOVE "ZZZZZZZZZZZZZZ" TO H-CODI .
DISPLAY P-CODI .
IF OPC = 01 GO INA4.
IF OPC = 02 MOVE "Vendedores " TO MENS2.
IF OPC = 03 MOVE "Condiciones " TO MENS2.
IF OPC = 04 MOVE "Localidades " TO MENS2.
IF OPC = 05 MOVE "Provincias " TO MENS2.
IF OPC = 06 MOVE "Zonas " TO MENS2.
IF OPC = 07 MOVE "Clientes " TO MENS2.
IF OPC = 08 MOVE "Proveedores " TO MENS2.
IF OPC = 09 MOVE "Marcas " TO MENS2.
IF OPC = 10 MOVE "Rubros " TO MENS2.
Codi1 INA2.
MOVE ZEROS TO TEC.
IF OPC = 02 OR = 03 OR = 05 OR = 06 OR = 07 OR = 08 OR = 09
OR = 10
DISPLAY P-CODI1 ACCEPT P-CODI1.
IF OPC = 04
DISPLAY P-CODI2 ACCEPT P-CODI2.
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA1.
IF T-F1
IF OPC = 02
CALL "AYUDVEND" USING D-CODI1
CANCEL "AYUDVEND" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
IF OPC = 03
especi CALL "AYUDCOND" USING D-CODI1
CANCEL "AYUDLOCA" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
IF OPC = 04
CALL "AYUDLOCA" USING EM, D-CODI2
CANCEL "AYUDPCIA" MOVE ZEROS TO TEC
MOVE D-CODI2 TO H-CODI2
END-IF
IF OPC = 05
CALL "AYUDPCIA" USING D-CODI1
CANCEL "AYUDPCIA" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
IF OPC = 06
CALL "AYUDZONA" USING D-CODI1
CANCEL "AYUDZONA" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
IF OPC = 07
CALL "AYUDCLIE" USING D-CODI1
CANCEL "AYUDCLIE" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
IF OPC = 08
CALL "AYUDPROV" USING D-CODI1
CANCEL "AYUDPROV" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
IF OPC = 09
CALL "AYUDMARC" USING D-CODI1
CANCEL "AYUDMARC" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
IF OPC = 10
especi CALL "AYUDRUBR" USING D-CODI1
CANCEL "AYUDRUBR" MOVE ZEROS TO TEC
MOVE D-CODI1 TO H-CODI1
END-IF
GO INA2.
IF NOT T-RET GO INA2.
IF OPC = 02 OR = 03 OR = 05 OR = 06 OR = 07 OR = 08 OR = 09
OR = 10
IF D-CODI1 = ZEROS
IF H-CODI1 = ZEROS
MOVE 0001 TO D-CODI1
MOVE 9999 TO H-CODI1
END-IF
IF H-CODI1 = ZEROS
MOVE "9999" TO H-CODI1
END-IF
END-IF
DISPLAY P-CODI1.
IF OPC = 04
IF D-CODI2 = ZEROS
IF H-CODI2 = ZEROS
MOVE 000000 TO D-CODI2
MOVE 999999 TO H-CODI2
END-IF
IF H-CODI2 = ZEROS
MOVE 999999 TO H-CODI2
END-IF
END-IF
DISPLAY P-CODI2.
INA3.
Fech INA4.
MOVE ZEROS TO TEC. DISPLAY P-FECH . ACCEPT P-FECH .
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA2.
IF NOT T-RET GO INA4.
MOVE D-FECH TO A-FECHA.
IF A-DIA > 31 OR = ZEROS GO INA4.
IF A-MES > 12 OR = ZEROS GO INA4.
IF A-ANO < 1980 OR = ZEROS GO INA4.
MOVE H-FECH TO A-FECHA.
IF A-DIA > 31 OR = ZEROS GO INA4.
IF A-MES > 12 OR = ZEROS GO INA4.
IF A-ANO < 1980 OR = ZEROS GO INA4.
DISPLAY P-FECH .
IF OPC NOT = 01
PERFORM 1S
GO INA6.
Fech1 INA5.
MOVE ZEROS TO TEC. DISPLAY P-FECH1. ACCEPT P-FECH1.
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA4.
IF NOT T-RET GO INA5.
IF D-FECH1 NOT = ZEROS
MOVE D-FECH1 TO A-FECHA
IF A-DIA > 31 OR = ZEROS GO INA5 END-IF
IF A-MES > 12 OR = ZEROS GO INA5 END-IF
IF A-ANO < 1980 OR = ZEROS GO INA5 END-IF.
IF H-FECH1 NOT = ZEROS
MOVE H-FECH1 TO A-FECHA
IF A-DIA > 31 OR = ZEROS GO INA5 END-IF
IF A-MES > 12 OR = ZEROS GO INA5 END-IF
IF A-ANO < 1980 OR = ZEROS GO INA5 END-IF.
DISPLAY P-FECH1.
PERFORM 1S.
Orde INA6.
MOVE ZEROS TO TEC. DISPLAY P-ORDE. ACCEPT P-ORDE.
ACCEPT TEC FROM ESCAPE KEY.
IF T-ESC OR T-F4
PERFORM 1N
IF OPC = 01 GO INA5 ELSE GO INA4.
IF NOT T-RET GO INA6. IF ORDE > 3 GO INA6.
DISPLAY P-ORDE.
IF OPC > 01 MOVE ZEROS TO D-FECH1 H-FECH1.
Modo INA7.
MOVE ZEROS TO TEC. DISPLAY P-MODO. ACCEPT P-MODO.
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA6.
IF NOT T-RET GO INA7. IF MODO > 1 GO INA7.
DISPLAY P-MODO.
CoSf INA7A.
MOVE ZEROS TO TEC. DISPLAY P-COSF. ACCEPT P-COSF.
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA7.
IF NOT T-RET GO INA7A. IF COSF > 1 GO INA7A.
DISPLAY P-COSF.
Vist INA8.
MOVE ZEROS TO TEC VIST OBRA OBRA2.
DISPLAY P-VIST. ACCEPT P-VIST.
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA7A.
IF NOT T-RET GO INA8. IF VIST > 3 GO INA8.
DISPLAY P-VIST.
IF MA = 1 GO INA8B.
Especi INA8A.
"" MOVE ZEROS TO TEC. MOVE SPACES TO TODO.
"" DISPLAY P-TODO. ACCEPT P-TODO.
"" ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA8.
"" IF NOT T-RET GO INA8A.
"" DISPLAY P-TODO.
Obra INA8B.
MOVE ZEROS TO TEC OBRA OBRA2.
DISPLAY P-OBRA. ACCEPT P-OBRA.
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA8.
IF NOT T-RET GO INA8B. IF OBRA > 2 GO INA8B.
IF OBRA = 1 GO INA9.
DISPLAY P-OBRA.
Obra2 INA8C.
MOVE 2 TO OBRA2.
* MOVE ZEROS TO TEC OBRA2. DISPLAY P-OBRA2. ACCEPT P-OBRA2.
* ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA8B.
* IF NOT T-RET GO INA8C. IF OBRA2 < 1 OR > 2 GO INA8C.
* DISPLAY P-OBRA2.
Acep INA9.
MOVE ZEROS TO TEC. MOVE SPACES TO SINO.
DISPLAY P-SINO. ACCEPT P-SINO.
ACCEPT TEC FROM ESCAPE KEY. IF T-ESC OR T-F4 GO INA8.
IF NOT T-RET GO INA9. IF NOT POSI GO INA9.
DISPLAY P-SINO. IF NONO PERFORM 0N GO INA0.
INI.
MOVE 1 TO BAN.
MOVE D-FECH TO A-FECHA. MOVE A-DIA TO W-DIA.
MOVE A-MES TO W-MES. MOVE A-ANO TO W-ANO.
MOVE W-FECHAX TO D-FE.
MOVE H-FECH TO A-FECHA. MOVE A-DIA TO W-DIA.
MOVE A-MES TO W-MES. MOVE A-ANO TO W-ANO.
MOVE W-FECHAX TO H-FE.
OPEN OUTPUT AAAA.
CLOSE AAAA.
OPEN OUTPUT BBBB.
CLOSE BBBB.
OPEN OUTPUT CCCC.
CLOSE CCCC.
Vtas IF OBRA = 0 OR = 1 PERFORM ARMA THRU F-ARMA.
Obra IF OBRA = 0 OR = 2
IF OBRA2 = 1 OR = 2
PERFORM ERME THRU F-ERME.
IF D-FECH1 NOT = ZEROS
IF OPC = 01 AND ORDE < 3
MOVE 2 TO BAN
MOVE D-FECH1 TO A-FECHA MOVE A-DIA TO W-DIA
MOVE A-MES TO W-MES MOVE A-ANO TO W-ANO
MOVE W-FECHAX TO D-FE
MOVE H-FECH1 TO A-FECHA MOVE A-DIA TO W-DIA
MOVE A-MES TO W-MES MOVE A-ANO TO W-ANO
MOVE W-FECHAX TO H-FE
PERFORM ARMA THRU F-ARMA.
PERFORM LIST THRU F-LIST.
PERFORM 1N. GO INA6.
FIN.
EXIT PROGRAM.
PARAR.
STOP RUN.