Copiar 000100 IDENTIFICATION DIVISION.
000200*************************
000300 PROGRAM-ID. ZTBGBU30.
000400 AUTHOR. ERITEL-5466.
000500*
000600******************************************************************
000700* OBJETO: *
000800* --> *
000900* - EJEMPLO DE PROGRAMA DE USUARIO DEL PROCEDIMIENTO POSTERIOR
001000* A EMISION
001100* - SI EL PROCESO POSTERIOR A EMISION FINALIZO CORRECTAMENTE
001200* SE REALIZA UNA NUEVA PETICION DE EMISION
001300* - EN CASO CONTRARIO SE EJECUTA OTRO PROCEDIMIENTO PARA MAR-
001400* CAR LA INCIDENCIA *
001500* *
001600******************************************************************
001700*
001800 ENVIRONMENT DIVISION.
001900**********************
002000 CONFIGURATION SECTION.
002100*----------------------
002200 SOURCE-COMPUTER. IBM-4331.
002300 OBJECT-COMPUTER. IBM-4331.
002400*
002500 INPUT-OUTPUT SECTION.
002600*---------------------
002700*
002800 FILE-CONTROL.
002900*
003000 SELECT ZTBGFINT ASSIGN TO ZTBGFINT
003100 FILE STATUS IS FS-ZTBGFINT.
003200*
003300 DATA DIVISION.
003400***************
003500*
003600 FILE SECTION.
003700*-------------
003800*
003900 FD ZTBGFINT
004000 LABEL RECORD STANDARD
004100 RECORDING MODE IS F
004200 BLOCK CONTAINS 0 RECORDS.
004300*
004400 01 REGISTRO-ZTBGFINT.
004500 05 FILLER PIC X(80).
004600/
004700 WORKING-STORAGE SECTION.
004800*------------------------
004900*----------------------------------------------------------------*
005000* CAMPOS ESPECIFICOS DEL PROGRAMA *
005100*----------------------------------------------------------------*
005200 77 FS-ZTBGFINT PIC XX VALUE '00'.
005300 77 SEGUIR PIC XX VALUE SPACES.
005400 77 I PIC 9(4) COMP VALUE 0.
005500 77 J PIC 9(4) COMP VALUE 0.
005600 77 K PIC 9(4) COMP VALUE 0.
005700 77 L PIC 9(4) COMP VALUE 0.
005800*
005900 01 LINEA PIC X(80) VALUE SPACES.
006000*
006100 01 LINEA-PROC.
006200 05 FILLER PIC X(16) VALUE '//PASO1 EXEC '.
006300 05 FICH1-PROC PIC X(32) VALUE SPACES.
006400 05 FILLER PIC X(32) VALUE SPACES.
006500*
006600*
006700*-----> CAMPOS PARA LA IGA
006800*
006900 01 WCOMIEN-JCL-IGA PIC X(16) VALUE '//PASO1 EXEC '.
007000 01 WCOMIEN2-JCL-IGA PIC X(11) VALUE '// '.
007100 01 NOMBRE-PROC PIC X(8) VALUE SPACES.
007200 01 ORIGEN-PROC PIC X(08) VALUE ',ORIGEN='.
007300 01 ORIGEN-PROC-2 PIC X(1) VALUE SPACES.
007400 01 FUNCION-PROC-2 PIC X(2) VALUE SPACES.
007500 01 WCOMILLA PIC X(1) VALUE ''''.
007600 01 WE PIC X(1) VALUE 'E'.
007700 01 WCOMA PIC X(1) VALUE ','.
007800 01 FUNCION-PROC PIC X(09) VALUE ',FUNCION='.
007900 01 WPET-IGA PIC X(02) VALUE SPACES.
008000 01 LOCAL0-PROC PIC X(04) VALUE ',L0='.
008100 01 LOCAL1-PROC PIC X(03) VALUE 'L1='.
008200 01 LOCAL2-PROC PIC X(04) VALUE ',L2='.
008300 01 REMOTO1-PROC PIC X(04) VALUE ',R1='.
008400 01 REMOTO2-PROC PIC X(04) VALUE ',R2='.
008500 01 APLICA-PROC PIC X(03) VALUE 'AP='.
008600*
008700 01 LOCAL0-PROC-2 PIC X(03) VALUE SPACES.
008800*
008900 01 SESION-PROC.
009000 05 LOCAL1-PROC-2 PIC X(06) VALUE SPACES.
009100 05 LOCAL2-PROC-2 PIC X(03) VALUE SPACES.
009200 05 REMOTO1-PROC-2 PIC X(06) VALUE SPACES.
009300 05 REMOTO2-PROC-2 PIC X(03) VALUE SPACES.
009400 05 APLICA-PROC-2 PIC X(06) VALUE SPACES.
009500*
009600*
009700*---> INCLUDE DEL AREA DE COMUNICACION COMUN
009800**** EXPANSION DE /INCLUDEC ZTBGCCOM
*---------------------------------------------------------------*
* AREA DE COMUNICACION COMUN PARA CONVERSORES.
* CONTIENE EL REGISTRO DE PREFILES DE LA IGA
* Y EL REGISTRO DE PREFILES DE EDITRAN.
*
*
*
* 23-3-93
* LA LONGITUD TOTAL DEL AREA = 10400 BYTES.
*---------------------------------------------------------------*
*
01 AREA-COMUN.
*
COPY ZTBGCRPE.
******************************************************************
* CONTIENE LA PARTE DE DATOS DE LOS PERFILES DE LA IGA. *
* EL NIVEL 01 DEL REGISTRO ESTA EN EL LIBRO (LWREGIGA). *
******************************************************************
*
03 REGISTRO-PERFILES-IGA.
05 CLAVE-PERFIGA.
10 PREFIJO PIC X.
10 SESION.
12 CODIGO-LOCAL PIC X(9).
12 CODIGO-REMOTO PIC X(9).
12 APLICACION PIC X(6).
10 NUMERO-ORDEN PIC X(2).
05 FILLER REDEFINES CLAVE-PERFIGA.
10 FILLER PIC X.
10 CODIGO-PRODUCTO-EDI-G PIC 9(02).
10 SESION-PRODUCTO-EDI-G.
15 ORI-PROD-EDI-G PIC X(9).
15 REM-PROD-EDI-G PIC X(9).
15 IAP-PROD-EDI-G PIC X(6).
05 REGISTRO-PERFIGA PIC X(2973).
*
* USER Y FECHA-HORA DE MODIFICACION.
* (EN REGS: ENTORNO, REMOTO, APLICACION, SES-PRESENT. Y FICHERO)
*
05 DATOS-ACTUALIZ-PERFIGA REDEFINES REGISTRO-PERFIGA.
10 FILLER PIC X(2951).
10 DATOS-ACT-REG-PERFIGA PIC X(22).
10 FILLER REDEFINES DATOS-ACT-REG-PERFIGA.
15 USER-ACT-REG-PERFIGA PIC X(8).
15 FECHA-ACT-REG-PERFIGA PIC X(8).
15 HORA-ACT-REG-PERFIGA PIC X(6).
*
* PREFIJO DEL REG. ENTORNO: E. RESTO DE LA CLAVE A CEROS
*
05 ENTORNO-IGA REDEFINES REGISTRO-PERFIGA.
07 DATOS-ENTORNO-IGA.
10 CODIGO-LOCAL-IGA-ENTORNO PIC X(9).
10 VERSION-IGA-LOCAL-ENTORNO PIC X(4).
10 VERSION-EDITRAN-LOCAL-ENTORNO PIC X(4).
10 PREFIJO-INSTALACION-ENTORNO PIC X(44).
10 MONITOR-ENTORNO PIC X(4).
10 TIPO-UNIDAD-ENTORNO PIC X(8).
10 LOG-ENTORNO PIC X(1).
10 PROC-PREV-EMISION-ENTORNO PIC X(8).
10 PROC-PREV-RECEPCION-ENTORNO PIC X(8).
10 PROC-POST-EMISION-ENTORNO PIC X(8).
10 PROC-POST-RECEPCION-ENTORNO PIC X(8).
10 PROC-EXCEPCION-ENTORNO PIC X(8).
10 FICHA-JOB-ENTORNO.
12 LINEA-JOB-ENTORNO OCCURS 5 PIC X(59).
10 PROC-ESTADOS-ENTORNO PIC X(8).
10 NOMBRE-ENTORNO PIC X(20).
10 VOL-O-POOL-ENTORNO PIC X(01).
10 VOL-TRABAJ-ENTORNO PIC X(08).
10 ALIAS-ENTORNO PIC X(3).
10 AJUSTAR-ESP-ENTORNO PIC X(1).
07 FILLER.
10 FILLER PIC X(2501).
10 DATOS-ACT-ENTORNO PIC X(22).
*
*
* PREFIJO DEL REG. SUBENTORNO: E. CODIGO Y RESTO DE CLAVE A CEROS
*
05 SUBENTORNO-IGA REDEFINES REGISTRO-PERFIGA.
10 DESCRIPCION-SUBENTORNO PIC X(44).
10 ALIAS-SUBENTORNO PIC X(03).
10 FILLER PIC X(2904).
10 DATOS-ACT-SUBENTORNO PIC X(22).
*
* PREFIJO DEL REG. REMOTO : R
*
05 C-REMOTO-IGA REDEFINES REGISTRO-PERFIGA.
07 DATOS-REMOTO-IGA.
10 DESCRIPCION-REMOTO PIC X(20).
10 VERSION-IGA-REMOTO PIC X(4).
10 ASCII-EBCDIC-REMOTO PIC X.
10 COMPRESION-REMOTO PIC X.
10 CRIPTOGRAFIA-REMOTO PIC X.
10 CRC-REMOTO PIC X.
10 ALGORITMO-CONF-REMOTO PIC X(4).
10 ALGORITMO-AUT-REMOTO PIC X(4).
10 INTERFAZ-CLAVES-REMOTO PIC X(8).
10 PARAMETROS-REMOTO PIC X(30).
10 CLAVE-LOC-REMOTO PIC X(64).
10 CLAVE-REM-REMOTO PIC X(64).
07 FILLER.
10 FILLER PIC X(2749).
10 DATOS-ACT-REMOTO PIC X(22).
*
*
* PREFIJO DEL REG. APLICACION: A
*
05 APLICACION-IGA REDEFINES REGISTRO-PERFIGA.
07 DATOS-APLICA-IGA.
10 DESCRIPCION-APLICACION PIC X(20).
10 ANTIGUOS-CONVERS-APLICACION PIC X(32).
10 FILLER REDEFINES ANTIGUOS-CONVERS-APLICACION.
15 CONVERSOR1-EMI-APLICACION PIC X(8).
15 CONVERSOR2-REC-APLICACION PIC X(8).
15 CONVERSOR3-EMI-APLICACION PIC X(8).
15 CONVERSOR4-REC-APLICACION PIC X(8).
10 PROG-PREVIO-EMI-APLICACION PIC X(8).
10 PROG-PREVIO-REC-APLICACION PIC X(8).
10 PROG-POST-EMI-APLICACION PIC X(8).
10 PROG-POST-REC-APLICACION PIC X(8).
10 PROG-EXCEPCION-APLICACION PIC X(8).
10 TRAD-EMI-APLICACION PIC X.
10 BORRAR-F-E-APLICACION PIC X.
10 BORRAR-F-R-APLICACION PIC X.
10 CRITERIO-DIVISION-APLICACION PIC X(2).
10 PARAMETRO-APLICACION PIC X(60).
10 TIPO-CARGA-APLICACION PIC X.
10 TIPO-DESCARGA-APLICACION PIC X.
10 EXIT-PREV-EMI-ANT-APLICACION PIC X(8).
10 EXIT-PREV-EMI-POS-APLICACION PIC X(8).
10 EXIT-POST-REC-ANT-APLICACION PIC X(8).
10 EXIT-POST-REC-POS-APLICACION PIC X(8).
10 LENG-DATOS-ORG-APLICACION PIC X.
10 TRAD-REC-APLICACION PIC X.
10 TABLA-CONV-EMI-APLICACION PIC X(8).
10 TABLA-CONV-REC-APLICACION PIC X(8).
10 FILLER PIC X(1).
10 CONFIRM-DESCARGAS-APLICACION PIC X(1).
10 CARGA-FF-APLICACION PIC X(1).
10 VERIF-FF-APLICACION PIC X(1).
10 PORCEN-AJUSTE-LZW-APLICACION PIC 9(2).
*cp
10 CODEPAGE-EMI-APLICACION PIC X(12).
10 PIC X(08).
*cp
10 CODEPAGE-REC-APLICACION PIC X(12).
10 PIC X(08).
*cdu
10 CONTROL-DUPLICADOS-APLICACION PIC X(1).
07 FILLER.
10 FILLER PIC X(2695).
10 DATOS-ACT-APLICACION PIC X(22).
*
* PREFIJO DEL REG. SESION PRESENTACION: P
*
05 SESION-IGA REDEFINES REGISTRO-PERFIGA.
07 PARAM-ENTORNO PIC X(500).
07 FILLER REDEFINES PARAM-ENTORNO.
10 CODIGO-LOCAL-IGA-SESION PIC X(9).
10 VERSION-IGA-LOCAL-SESION PIC X(4).
10 VERSION-EDITRAN-LOCAL-SESION PIC X(4).
10 PREFIJO-INSTALACION-SESION PIC X(44).
10 MONITOR-SESION PIC X(4).
10 TIPO-UNIDAD-SESION PIC X(8).
10 LOG-SESION PIC X(1).
10 PROC-PREV-EMISION-SESION PIC X(8).
10 PROC-PREV-RECEPCION-SESION PIC X(8).
10 PROC-POST-EMISION-SESION PIC X(8).
10 PROC-POST-RECEPCION-SESION PIC X(8).
10 PROC-EXCEPCION-SESION PIC X(8).
10 FICHA-JOB-SESION.
12 LINEA-JOB-SESION OCCURS 5 PIC X(59).
10 PROC-ESTADOS-SESION PIC X(8).
10 NOMBRE-ENT-SUBENTORNO-SESION PIC X(20).
10 VOLUMEN-O-POOL-TRABAJ-SESION PIC X.
10 VOLUMEN-TRABAJO-SESION PIC X(8).
10 ALIAS-SESION PIC X(3).
10 AJUSTAR-ESP-SESION PIC X(1).
10 FILLER PIC X(50).
* 10 FILLER PIC X(51).
07 FILLER PIC X(250).
07 PARAM-REMOTO PIC X(202).
07 FILLER REDEFINES PARAM-REMOTO.
10 DESCRIPCION-REMOTO-SESION PIC X(20).
10 VERSION-IGA-SESION PIC X(4).
10 ASCII-EBCDIC-SESION PIC X.
10 COMPRESION-SESION PIC X.
10 CRIPTOGRAFIA-SESION PIC X.
10 CRC-SESION PIC X.
10 ALGORITMO-CONF-SESION.
15 ALG-CONF-SESION PIC X(4).
10 ALGORITMO-AUT-SESION PIC X(4).
10 INTERFAZ-CLAVES-SESION PIC X(8).
10 PARAMETROS-SESION PIC X(30).
10 CLAVE-LOC-SESION PIC X(64).
10 CLAVE-REM-SESION PIC X(64).
*
07 FILLER PIC X(260).
07 PARAM-APLICACION PIC X(300).
07 FILLER REDEFINES PARAM-APLICACION.
10 DESCRIPCION-APL-SESION PIC X(20).
10 ANTIGUOS-CONVERS-SESION PIC X(32).
10 FILLER REDEFINES ANTIGUOS-CONVERS-SESION.
15 CONVERSOR1-EMI-APL-SESION PIC X(8).
15 CONVERSOR2-REC-APL-SESION PIC X(8).
15 CONVERSOR3-EMI-APL-SESION PIC X(8).
15 CONVERSOR4-REC-APL-SESION PIC X(8).
10 PROG-PREVIO-EMI-APL-SESION PIC X(8).
10 PROG-PREVIO-REC-APL-SESION PIC X(8).
10 PROG-POST-EMI-APL-SESION PIC X(8).
10 PROG-POST-REC-APL-SESION PIC X(8).
10 PROG-EXCEPCION-APL-SESION PIC X(8).
10 TRAD-EMI-APL-SESION PIC X.
10 BORRAR-F-E-APL-SESION PIC X.
10 BORRAR-F-R-APL-SESION PIC X.
10 CRITERIO-DIVISION-APL-SESION PIC X(2).
10 PARAMETRO-APL-SESION PIC X(60).
10 TIPO-CARGA-APL-SESION PIC X(1).
10 TIPO-DESCARGA-APL-SESION PIC X(1).
10 EXIT-PREV-EMI-ANT-APL-SESION PIC X(8).
10 EXIT-PREV-EMI-POS-APL-SESION PIC X(8).
10 EXIT-POST-REC-ANT-APL-SESION PIC X(8).
10 EXIT-POST-REC-POS-APL-SESION PIC X(8).
10 LENG-DATOS-ORG-APL-SESION PIC X(01).
10 TRAD-REC-APL-SESION PIC X(01).
10 TABLA-CONV-EMI-APL-SESION PIC X(08).
10 TABLA-CONV-REC-APL-SESION PIC X(08).
10 FILLER PIC X(1).
10 CONFIRM-DESCARGAS-APL-SESION PIC X(1).
10 CARGA-FF-APL-SESION PIC X(1).
10 VERIF-FF-APL-SESION PIC X(1).
10 PORCEN-AJUSTE-LZW-SESION PIC 9(2).
*cp
10 CODEPAGE-EMI-APL-SESION PIC X(12).
10 PIC X(08).
*cp
10 CODEPAGE-REC-APL-SESION PIC X(12).
10 PIC X(08).
*cdu
10 CONTROL-DUPLICADOS-APL-SESION PIC X(1).
10 PIC X(44).
07 FILLER PIC X(200).
07 PARAM-PRESENTACION PIC X(1134).
07 FILLER REDEFINES PARAM-PRESENTACION.
10 DESCRIPCION-SESION PIC X(20).
10 NUMERO-SESIONES-TRANSMISION PIC 99.
10 TABLA-SESIONES.
12 ELEMENTO OCCURS 20.
14 SESION-TRANSMISION.
16 REMOTO-TRANSMISION PIC X(9).
16 APLICA-TRANSMISION PIC X(6).
14 VOLUMEN-FICHERO-TAMP-E PIC X(8).
14 FILLER REDEFINES VOLUMEN-FICHERO-TAMP-E.
16 STOCL-FICHERO-TAMP-E PIC X(8).
14 NUM-REG-TAMPON-ALF PIC X(5).
14 FILLER REDEFINES NUM-REG-TAMPON-ALF.
16 NUMERO-REGISTROS-TAMPON PIC 9(5).
14 FILLER REDEFINES NUM-REG-TAMPON-ALF.
16 BYTE1-NUM-REG-TAMP PIC X.
16 NUM-REGS-TAMPON-COMP PIC 9(8) COMP.
*--> TABLA NO SE UTILIZA A PARTIR DE VERSION-EDI-G-41
10 TABLA-FICHEROS-RECEPCION.
12 ELEMENTO2 OCCURS 5.
14 NOMBRE-FISICO-R-OLD PIC X(44).
14 VOLUMEN-R PIC X(8).
14 FILLER REDEFINES VOLUMEN-R.
16 STOCL-R PIC X(8).
14 IDENTIFICADOR-R PIC X(8).
14 LRECL-R PIC 9(5).
10 FILLER REDEFINES TABLA-FICHEROS-RECEPCION.
12 NOMBRE-FISICO-R PIC X(44).
12 FILLER PIC X(281).
10 BORRAR-FA-SI-EXISTE PIC X.
10 VOLSER-O-UNIT PIC X(1).
10 VOLSER-RECEP-V21 PIC X(8).
10 FILLER REDEFINES VOLSER-RECEP-V21.
12 STOCL-RECEP-V21 PIC X(8).
10 UNIT-DE-VOLSER-V21 PIC X(8).
*--> TABLA NO SE UTILIZA A PARTIR DE VERSION-EDI-G-41
10 TABLA-UNIT-V20.
12 ELEMENTO3 OCCURS 5.
14 UNIT-DE-VOLSER-V20 PIC X(8).
10 INCREMENTAR-SESION PIC X(1).
10 FORMATO-FICH-DESCARGA PIC X(1).
10 FICHERO-UNICO-RECEPCION PIC X(1).
10 VOLUMEN-POOL-TAMPONES PIC X(1).
10 TABLA-VOL-TAM-FICH-R.
12 ELEMENTO-TABLA-VOL-TAM-R OCCURS 20.
14 VOLUMEN-FICHERO-TAMP-R PIC X(8).
14 FILLER REDEFINES VOLUMEN-FICHERO-TAMP-R.
16 STOCL-FICHERO-TAMP-R PIC X(8).
10 LONG-FICH-DESCARGA.
12 LONAPL-DESCARGA PIC 9(5).
07 FILLER PIC X(105).
07 DATOS-ACT-SESION PIC X(22).
*
* PREFIJO DEL REG. SESION TRANSMISION : T
*
05 SESION-TRANSMISION-IGA REDEFINES REGISTRO-PERFIGA.
10 SESION-ASOCIADA.
15 CODIGO-LOCAL-P PIC X(9).
15 CODIGO-REMOTO-P PIC X(9).
15 APLICACION-P PIC X(6).
10 FILLER PIC X(2927).
10 DATOS-ACT-SES-TRAN PIC X(22).
*
* PREFIJO DEL REG. FICHERO DE APLICACION : F
*
05 FICHERO-APLICACION-IGA REDEFINES REGISTRO-PERFIGA.
10 NOMBRE-FISICO-E PIC X(44).
*--> CAMPO NO SE UTILIZA A PARTIR DE VERSION-EDI-G-41
10 IDENTIFICADOR-E PIC X(8).
10 FORMATO-FICHERO-E PIC X.
10 LENG-DATOS-ORG-E PIC X.
10 TRAD-EMI-E PIC X.
10 COMPRESION-E PIC X.
*cp
10 CODEPAGE-E PIC X(12).
10 FILLER PIC X(2883).
10 DATOS-ACT-FICHERO PIC X(22).
*
* PREFIJO DEL REG. LICENCIAS: Z. CODIGO Y RESTO DE CLAVE A CEROS
*
05 REG-LIC-ZTBGFPE REDEFINES REGISTRO-PERFIGA.
10 IDENTIF-ORIGEN-LIC-ZTBGFPE PIC X(15).
10 TIPO-REGISTRO-LIC-ZTBGFPE PIC X(01).
10 DATOS-A-ENMAS-LIC-ZTBGFPE.
15 COD-ENT-LIC-ZTBGFPE.
20 COD1-ENT-LIC-ZTBGFPE PIC X.
20 CODX-ENT-LIC-ZTBGFPE PIC X(3).
20 COD9-ENT-LIC-ZTBGFPE PIC X.
15 CADUC-ENT-LIC-ZTBGFPE PIC X(4).
15 ID-CODIGO-LIC-ZTBGFPE PIC X(15).
15 VERSION-LIC-ZTBGFPE PIC X(4).
15 TIPO-LIC-ZTBGFPE PIC X.
15 DATOS-SES-PROD-ZTBGFPE.
20 SESION-PROD-G-REG-Y PIC X(24).
20 IDENTIF-SES-G-REG-Y PIC X(15).
20 RESTO-SES-G-REG-Y PIC X(61).
15 FILLER REDEFINES DATOS-SES-PROD-ZTBGFPE.
20 TABLA-PRODUCTOS-LIC-ZTBGFPE OCCURS 20.
25 CADUC-PRO-LIC-ZTBGFPE PIC X(4).
25 TIPO-PRO-LIC-ZTBGFPE PIC X.
15 FILLER PIC X.
10 DATOS-ENMASCAR-LIC-ZTBGFPE PIC X(130).
10 fecha-mtto-lic-ztbgfpe.
15 a-mtto-lic-ztbgfpe pic x.
10 pic x(2696).
COPY ZTBGC004.
*----------------------------------------------------------------*
*-- PARTE DE DATOS DEL PROGRAMA ZTBGB004... *
* LONGITUD : 4850 BYTES (20/08/97)
*
*-- CODIGOS DE RESULTADO DEL ZTBGB004
* CODIGO-RDO DESCRIPCION
* ---------- --------------------------------------------------
* 00 NO SE HA DETECTADO INCIDENCIAS
* OTROS COINCIDEN CON LOS CODIGOS DE LOS MENSAJES DE
* EDITRAN/G
*
*-- CODIGOS INFORMATIVOS DE LOS PARAMETOS DE LAS S-T
* RDO-LONG-TRANS DESCRIPCION
* -------------- ----------------------------------------------
* 00 LONGITUDES DE TRANSMISION CORRECTAS
* 01 S-T CON LONGITUDES DE TRANSMISION DIFERENTES
*
* RDO-COMPRESION DESCRIPCION
* -------------- ----------------------------------------------
* 00 SESIONES DE TRANSMISION SIN COMPRESION
* 01 AL MENOS UNA SESION UTILIZA COMPRESION
*
* RDO-CIFRADO DESCRIPCION
* -------------- ----------------------------------------------
* 01 S-T CON VERSIONES DE CRIPTOGRAFIA DIFERENTES
* 02 VERSIONES DE CRIPTOGRAFIA NO CUMPLIMENTADAS
* (TODAS CON ESPACIOS O LOW-VALUES)
* 03 VERSION-EDI-S-220 SIN CRIPTOGRAFIA
* 04 VERSION-EDI-S-220 CON AUTENTICACI. Y CAMBIO DE
* CLAVE
*
* RDO-TAMPON-E/R DESCRIPCION
* -------------- ----------------------------------------------
* 01 S-T CON TIPO (M/E) DE TAMPONES (E/R) DISTINTOS
* 02 S-T TAMPONES MATRICIALES (E/R) DIFERENTES
* 03 TAMPONES DE EMISION NO CONSECUTIVOS
* 04 NIGUN TAMPON DE EMISION CUMPLIMENTADO
* O ALGUN TAMPON DE RECEPCION NO CUMPLIMENTADO
* 05 TIPO DE TAMPON DESCONOCIDO PARA EDITRAN/G
*----------------------------------------------------------------*
*
03 RESTO-AREA-ZTBGB004.
05 PROCESO-LLAMANTE-ZTBGB004 PIC X(1).
05 SESION-PRES-ZTBGB004 PIC X(32).
05 LOG-SESION-ZTBGB004 PIC X(01).
05 CODIGO-RDO-ZTBGB004 PIC 9(4).
05 FILE-STATUS-ZTBGB004 PIC X(2).
05 ERRCOD-ZTBGB004 PIC 9(5).
05 TABLA-FICHAS-ZTBGB004.
10 ELEMENTO-FICHA-ZTBGB004 PIC X(59) OCCURS 5.
05 TABLA-SESIONES-ZTBGB004 PIC X(3520).
05 FILLER REDEFINES TABLA-SESIONES-ZTBGB004 OCCURS 20.
10 ELEMENTO-SESION-ZTBGB004.
15 RDO-TRANSMISION-ZTBGB004 PIC 9(4).
15 SESION-TRANSMISION-ZTBGB004.
20 ORIGEN-ZTBGB004 PIC X(9).
20 REMOTO-ZTBGB004 PIC X(9).
20 APLICACION-ZTBGB004 PIC X(6).
15 FICHERO-EMISION-ZTBGB004.
20 LOGICO-EMISION-ZTBGB004 PIC X(7).
20 FISICO-EMISION-ZTBGB004 PIC X(44).
15 FICHERO-RECEPCION-ZTBGB004.
20 LOGICO-RECEPCION-ZTBGB004 PIC X(7).
20 FISICO-RECEPCION-ZTBGB004 PIC X(44).
15 LONGITUD-FICHERO-ZTBGB004 PIC 9(04).
15 VERSION-EDI-REMOTO-ZTBGB004 PIC 9(02).
15 TIPO-TAMPON-EMIS-ZTBGB004 PIC X(1).
15 TIPO-TAMPON-RECEP-ZTBGB004 PIC X(1).
15 COMPRESION-ZTBGB004 PIC X(1).
15 CRIPTOGRAFIA-ZTBGB004 PIC X(1).
15 CAMBIO-CLAVE-ZTBGB004 PIC X(1).
15 CLAVE-EMK-BAJO-AK-ZTBGB004 PIC X(8).
15 CLAVE-TKE-BAJO-EMK-ZTBGB004 PIC X(8).
15 CLAVE-TKR-BAJO-EMK-ZTBGB004 PIC X(8).
15 VERSION-CRIP-ZTBGB004.
17 VERSION-2-CRIP-ZTBGB004 PIC X(2).
17 FILLER PIC X(1).
15 ALGORITMO-CONF-ZTBGB004 PIC X(4).
15 ALGORITMO-AUT-ZTBGB004 PIC X(4).
05 DATOS-ENTORNO-ZTBGB004.
10 NOMBRE-CICS-ZTBGB004 PIC X(08).
10 TRANSACCION-ZTBGB004 PIC X(04).
10 TRANS-EXCI-ZTBGB004 PIC X(04).
* EN PRINCIPIO, VERSION Y CODIGO LOCAL EDITRAN, SON DATOS ENTRADA
10 CODIGO-LOCAL-ZTBGB004 PIC X(09).
10 VERSION-EDITRAN-LOCAL-ZTBGB004 PIC X(4).
10 ALIAS-ENT-SUBENT-ZTBGB004 PIC X(3).
05 DSNAME-ZTBGFEST-ZTBGB004 PIC X(44).
05 LABEL-LOCAL-ZTBGB004 PIC X(8).
05 LABEL-REMOTO-ZTBGB004 PIC X(8).
05 PIC 9(6).
05 PIC 9(6).
05 NOMBRE-CPU-ZTBGB004 PIC X(8).
05 NETNAME-EXCI-ZTBGB004 PIC X(08).
05 DSNAME-ZTBEFMP-ZTBGB004 PIC X(44).
05 TABLA-SES-INTERNAS-ZTBGB004 PIC X(640).
05 FILLER REDEFINES TABLA-SES-INTERNAS-ZTBGB004 OCCURS 20.
10 SESION-INTERNA-ZTBGB004 PIC X(32).
* CODIGOS DE RESULTADO INFORMATIVOS SOBRE PARAMETROS DE LAS S-T
05 RDO-LONG-TRANS-ZTBGB004 PIC X(2).
05 IND-LONG-TRANS-ZTBGB004 PIC 9(2).
05 RDO-COMPRESION-ZTBGB004 PIC X(2).
05 IND-COMPRESION-ZTBGB004 PIC 9(2).
05 RDO-CIFRADO-ZTBGB004 PIC X(2).
05 IND-CIFRADO-ZTBGB004 PIC 9(2).
05 RDO-TAMPON-E-ZTBGB004 PIC X(2).
05 IND-TAMPON-E-ZTBGB004 PIC 9(2).
05 RDO-TAMPON-R-ZTBGB004 PIC X(2).
05 IND-TAMPON-R-ZTBGB004 PIC 9(2).
05 RDO-JCLS-IGUALES-ZTBGB004 PIC X(2).
05 IND-JCLS-IGUALES-ZTBGB004 PIC 9(2).
05 NBRE-APL-CICS-ZTBGB004 PIC X(8).
05 IDENTIF-JCLS-ENT-ZTBGB004 PIC X(01).
05 PIC X(77).
05 TRAN-ALARMA-ZTBGB004 PIC X(1).
05 FILLER PIC X(75).
03 VBLES-PROC-COMUN.
05 NRO-SESION-COMUN PIC 9(4).
05 SENTIDO-COMUN PIC X(1).
05 ESTADO-PRESENTACION-COMUN PIC 9(3).
* último registro csb cargado
05 ULT-REG-CSB-CAR-COMUN PIC 9(12).
* último registro tampón cargado en carga acumulativa
05 ULT-REG-TAM-CAR-COMUN PIC 9(12).
05 ENQ-PRESENTACION-COMUN PIC X(1).
05 PROCESO-PERMITIDO-COMUN PIC X(1).
05 CARGAR-TAMPONES-COMUN PIC X(1).
05 CARGAR-CSB-COMUN PIC X(1).
05 FESQ-CREADO-COMUN PIC X(1).
05 RESULTADO-COMUN PIC 9(4).
05 FICHCAR-COMUN PIC X(1).
05 ULTIMO-MSJE-COMUN.
07 CODIGO-MSJE-COMUN PIC X(4).
07 TEXTO-MSJE-COMUN PIC X(60).
05 LICENCIA-LZW-COMUN PIC X(1).
05 LICENCIA-FF-COMUN PIC X(1).
05 SUBS-CLV-LOC-COMUN PIC X.
05 VERS-CLV-LOC-COMUN PIC 99.
05 SUBS-CLV-REM-COMUN PIC X.
05 VERS-CLV-REM-COMUN PIC 99.
*cdu
05 FECHA-HORA-CDU-COMUN PIC X(14).
05 PIC X(16).
** CAMPOS PARA VERSION IMS.
05 BORRA-CLAVES-COMUN PIC X.
05 CAMB-VERS-G-COMUN PIC X.
05 NOVA-VERS-G-COMUN PIC X(4).
** REGISTRO DE CABECERA EN RECEPCION OBTENIDO EN ZTBGB241
03 REG-CABCSB-COMUN PIC X(240).
03 RESTO-AREA-COMUN PIC X(2160).
66 ESTADO-COMUN RENAMES ESTADO-PRESENTACION-COMUN.
*---------------------------------------------------------------*
*- AREA DE COMUNICACION CON LOS PROGRAMAS DE USUARIO -*
*---------------------------------------------------------------*
01 WPROG-USUARIO PIC X(08) VALUE SPACES.
*
01 AREA-U0V30000.
03 RESTO-AREA-U0V30000.
05 CODIGO-RDO-U0V30000 PIC 9(4).
05 CODIGO-RET-U0V30000 PIC 9(4).
05 MENSAJE-U0V30000 PIC X(100).
05 FILLER REDEFINES MENSAJE-U0V30000.
10 LONGITUD-U0V30000 PIC 9(4) COMP.
10 ORIGEN-U0V30000 PIC X(01).
10 FUNCION-U0V30000 PIC X(02).
10 SESION-PRESENTACION-U0V30000.
15 LOCAL-U0V30000 PIC X(9).
15 REMOTO-U0V30000 PIC X(9).
15 APLICACION-U0V30000 PIC X(6).
*-REDEFINICION DE LA SESION DE PRESENTACION (SOLO SI ORIGEN E)
*-LLEGA AQUI LA SESION DE TRANSMISION
*-LA SESION DE PRESENTACION ESTA EN PERFILES, CAMPO SESION
10 FILLER REDEFINES SESION-PRESENTACION-U0V30000.
15 SESION-TRANS-U0V30000 PIC X(24).
10 REFERENCIA-A7I-U0V30000 PIC X(04).
10 FILLER PIC X(67).
05 RESTO2-AREA-U0V30000 PIC X(2052).
*- -*
044500*
044600 LINKAGE SECTION.
044700*----------------
044800*
044900 01 AREA-ENTRADA PIC X(10400).
045000*
045100 PROCEDURE DIVISION USING AREA-ENTRADA.
045200*--------------------------------------
045300*
045400 N1-P-PROGRAMA.
045500*--------------
045600*
045700*
045800 MOVE AREA-ENTRADA TO AREA-COMUN
045900 MOVE RESTO-AREA-COMUN TO RESTO-AREA-U0V30000
046000 MOVE ZEROS TO CODIGO-RDO-U0V30000
046100*
046200 PERFORM N2-P-PROCESO
046300 THRU N2-F-PROCESO.
046400*
046500* ----- SI SE HA PRODUCIDO UN ERROR O INCIDENCIA, SEGUIR = 'NO' Y
046600* ----- SE GRABA LA INCIDENCIA EN EL LOG Y FINALIZA EL PROCESO.
046700*
046800*
046900 MOVE RESTO-AREA-U0V30000 TO RESTO-AREA-COMUN
047000 MOVE AREA-COMUN TO AREA-ENTRADA.
047100*
047200 N1-F-PROGRAMA.
047300*--------------
047400 GOBACK.
047500/
047600*NIVEL II.
047700*
047800 N2-P-PROCESO.
047900*--------------*
048000*
048100 PERFORM N4-P-ABRIR-ZTBGFINT
048200 THRU N4-F-ABRIR-ZTBGFINT.
048300*
048400*--- SE ESCRIBEN LAS 5 PRIMERAS FICHAS DEL JCL
048500*
048600 PERFORM R-P-ESCRIBE-FICHA-JOB
048700 THRU R-F-ESCRIBE-FICHA-JOB
048800 VARYING I FROM 1 BY 1
048900 UNTIL I > 5 OR SEGUIR = 'NO'.
049000*
049100*--- SE ESCRIBE LA FICHA DEL EXEC DEL PROCEDIMIENTO
049200*
049300 IF SEGUIR = 'SI'
049400 PERFORM R-P-ESCRIBE-PROCEDIMIENTO
049500 THRU R-F-ESCRIBE-PROCEDIMIENTO.
049600*
049700*--- SE ESCRIBE LA FICHA DE FIN DE JCL
049800*
049900 IF SEGUIR = 'SI'
050000 MOVE '//' TO LINEA
050100 PERFORM R-P-ESCRIBE
050200 THRU R-F-ESCRIBE.
050300*
050400*--- AL CERRAR LA INTERNAL-READER SE SUBMITE EL PROCEDIMIENTO.
050500*
050600 PERFORM N4-P-CERRAR-ZTBGFINT
050700 THRU N4-F-CERRAR-ZTBGFINT.
050800*
050900 N2-F-PROCESO.
051000*--------------*
051100 EXIT.
051200*
051300*NIVEL IV.
051400*
051500 N4-P-ABRIR-ZTBGFINT.
051600*-----------------*
051700*
051800 OPEN OUTPUT ZTBGFINT.
051900*
052000 IF FS-ZTBGFINT = '00'
052100 MOVE 'SI' TO SEGUIR
052200 ELSE
052300 MOVE 'NO' TO SEGUIR
052400 MOVE 1 TO CODIGO-RDO-U0V30000.
052500*
052600 N4-F-ABRIR-ZTBGFINT.
052700*-----------------*
052800 EXIT.
052900*
053000 N4-P-CERRAR-ZTBGFINT.
053100*-------------------*
053200*
053300*---- EN ESTE MOMENTO SE SUBMITE EL PROCEDIMIENTO.
053400*
053500 CLOSE ZTBGFINT.
053600*
053700 IF SEGUIR = 'SI' AND FS-ZTBGFINT NOT = '00'
053800 MOVE 'NO' TO SEGUIR
053900 MOVE 2 TO CODIGO-RDO-U0V30000.
054000*
054100 N4-F-CERRAR-ZTBGFINT.
054200*-------------------*
054300 EXIT.
054400/
054500*
054600 R-P-ESCRIBE-FICHA-JOB.
054700*----------------------*
054800*
054900 MOVE ELEMENTO-FICHA-ZTBGB004 (I) TO LINEA.
055000*
055100 PERFORM R-P-ESCRIBE
055200 THRU R-F-ESCRIBE.
055300*
055400 R-F-ESCRIBE-FICHA-JOB.
055500*----------------------*
055600 EXIT.
055700*
055800 R-P-ESCRIBE-PROCEDIMIENTO.
055900*--------------------------*
056000*
056100 MOVE 'A' TO ORIGEN-PROC-2
056200 MOVE FUNCION-U0V30000 TO FUNCION-PROC-2
*
IF ORIGEN-U0V30000 = 'E'
MOVE SESION TO SESION-PROC
ELSE
MOVE SESION-PRESENTACION-U0V30000 TO SESION-PROC.
*
056400 MOVE ALIAS-ENT-SUBENT-ZTBGB004 TO LOCAL0-PROC-2
056500*
056600 IF CODIGO-RET-U0V30000 = ZEROS
056700 IF FUNCION-U0V30000 = '07'
056800 MOVE '06' TO FUNCION-PROC-2
056900 MOVE PROC-PREV-RECEPCION-SESION TO NOMBRE-PROC
057000 MOVE SESION TO SESION-PROC
057100 ELSE
057200 MOVE '01' TO FUNCION-PROC-2
057300 MOVE PROC-PREV-EMISION-SESION TO NOMBRE-PROC
057400 MOVE SESION TO SESION-PROC
057500 ELSE
057600 MOVE 'D3ZTBGLU' TO NOMBRE-PROC.
057700*
057800 STRING WCOMIEN-JCL-IGA DELIMITED BY SIZE
057900 NOMBRE-PROC DELIMITED BY SPACE
058000 ORIGEN-PROC DELIMITED BY SIZE
058100 WCOMILLA DELIMITED BY SIZE
058200 ORIGEN-PROC-2 DELIMITED BY SIZE
058300 WCOMILLA DELIMITED BY SIZE
058400 FUNCION-PROC DELIMITED BY SIZE
058500 WCOMILLA DELIMITED BY SIZE
058600 FUNCION-PROC-2 DELIMITED BY SIZE
058700 WCOMILLA DELIMITED BY SIZE
058800 LOCAL0-PROC DELIMITED BY SIZE
058900 WCOMILLA DELIMITED BY SIZE
059000 LOCAL0-PROC-2 DELIMITED BY SIZE
059100 WCOMILLA DELIMITED BY SIZE
059200 WCOMA DELIMITED BY SIZE
059300 INTO LINEA.
059400*
059500 PERFORM R-P-ESCRIBE
059600 THRU R-F-ESCRIBE.
059700*
059800 STRING WCOMIEN2-JCL-IGA DELIMITED BY SIZE
059900 LOCAL1-PROC DELIMITED BY SIZE
060000 WCOMILLA DELIMITED BY SIZE
060100 LOCAL1-PROC-2 DELIMITED BY SIZE
060200 WCOMILLA DELIMITED BY SIZE
060300 LOCAL2-PROC DELIMITED BY SIZE
060400 WCOMILLA DELIMITED BY SIZE
060500 LOCAL2-PROC-2 DELIMITED BY SIZE
060600 WCOMILLA DELIMITED BY SIZE
060700 REMOTO1-PROC DELIMITED BY SIZE
060800 WCOMILLA DELIMITED BY SIZE
060900 REMOTO1-PROC-2 DELIMITED BY SIZE
061000 WCOMILLA DELIMITED BY SIZE
061100 REMOTO2-PROC DELIMITED BY SIZE
061200 WCOMILLA DELIMITED BY SIZE
061300 REMOTO2-PROC-2 DELIMITED BY SIZE
061400 WCOMILLA DELIMITED BY SIZE
061500 WCOMA DELIMITED BY SIZE
061600 INTO LINEA.
061700*
061800 PERFORM R-P-ESCRIBE
061900 THRU R-F-ESCRIBE.
062000*
062100 STRING WCOMIEN2-JCL-IGA DELIMITED BY SIZE
062200 APLICA-PROC DELIMITED BY SIZE
062300 WCOMILLA DELIMITED BY SIZE
062400 APLICA-PROC-2 DELIMITED BY SIZE
062500 WCOMILLA DELIMITED BY SIZE
062600 INTO LINEA.
062700*
062800 PERFORM R-P-ESCRIBE
062900 THRU R-F-ESCRIBE.
063000*
063100 R-F-ESCRIBE-PROCEDIMIENTO.
063200*-------------------------*
063300 EXIT.
063400*
063500*
063600 R-P-ESCRIBE.
063700*------------*
063800*
063900 WRITE REGISTRO-ZTBGFINT FROM LINEA.
064000*
064100 IF FS-ZTBGFINT = '00'
064200 MOVE SPACES TO LINEA
064300 MOVE 'SI' TO SEGUIR
064400 ELSE
064500 MOVE 'NO' TO SEGUIR
064600 MOVE 4 TO CODIGO-RDO-U0V30000.
064700*
064800 R-F-ESCRIBE.
064900*------------*
065000 EXIT.
065100*