*------------------------------------------------
* INFORMACION DEL PROGRAMA
*
* Nombre del Sistema : SINACOFI
* Nombre Prog. Fuente : FRAVISIN
* Nombre Prog. Objeto : FRAVISIN en Biblioteca SFDOBJA1.SADE
* Tipo de Programa : SCREEN COBOL
* Descripcion Breve : Este es el Driver de comunicacion entre los
* SERVER y los TID, via UMP.
* *
* Recibe los avisos de que existe un mensaje para
* un TID especifico, los cuales seran requeridos
* posteriormente por el programa denominado SOQUET
*
* Ademas, es capaz de despachar directamente los
* Avisos de sistema.
*
* Uso bajo PATHWAY: Este programa corresponde a un terminal PATHWAY
* cuya denominancion debe ser
*
* TUMP-tcp-tid,
*
* tcp: Numero del TCP, p.e. tcp-01 -> 01
* tid: Numero del TID
*
* Procesamienteo COOPERATIVO: *
* Este programa opera en forma cooperativa *
* con el requester FRTRNSIN, y con el server FSDRVCOM*
*
* FRTRNSIN: corresponde al term PATHWAY TERM-tcp-tid
* PROCESS $PPtid
* FRTRNAVI: corresponde al term PATHWAY TUMP-tcp-tid
* PROCESS $PPtid
* FSDRVCOM: corresponde al server PATHWAY OSDRVCOM-tid,
* $PPtid
* En la Compilacion si se le da SETTOG :
*
* (1) Asume Driver SIN Encriptacion de Datos.
* ( Queda con el Nombre en Libreria de Objetos
* ( FRTRNSIN )).
* *
*
*
* INFORMACION CONTEXTO
*
* Tablas o Archivos :
* Bibliotecas de Copy : LBAPLCOB
* Parametros I/O :
* Rutinas Utilizadas :
*-------------------------------------------
*
* REGISTRO DE MANTENCION
*
* Fecha Modificacion :
* Responsable Modific. :
* Razon de la Modific. :
*
*-------------------------------------------
IDENTIFICATION DIVISION.
*========================
PROGRAM-ID. FRAVISIN.
AUTHOR. TANDEM CHILE SA - CLR.
DATE-WRITTEN.
DATE-COMPILED.
ENVIRONMENT DIVISION.
*=====================
CONFIGURATION SECTION.
SOURCE-COMPUTER. HIMALAYA 100.
OBJECT-COMPUTER. HIMALAYA 100, TERMINAL IS INTELLIGENT-0.
DATA DIVISION.
*==============
WORKING-STORAGE SECTION.
*=======================
01 WS-AREA-MENSAJE-UMP.
02 WS-REPLY-CODE PIC 9(4) COMP.
02 WS-UMP-AREA-DATA PIC X(191).
02 WS-MSG-UMP-A-LOS-TID redefines WS-UMP-AREA-DATA.
COPY AREA-HEADER-ENTRADA-SINA.
COPY AREA-AVISOS-CONFIRMACION.
01 Ws-Ump-Code Pic 9(4) Comp.
01 WS-AREA-REPLY-CODE.
COPY AREA-REPLY-CODE.
***********************************************************
* declaracion mensaje entrada al host tandem *
***********************************************************
01 WS-AREA-MENSAJE-ENTRADA-SINA.
COPY AREA-HEADER-ENTRADA-SINA.
COPY AREA-TEXTO-ENTRADA-SINA.
***********************************************************
* ENVIO, RECEPCION DE DATOS *
***********************************************************
01 RSC-RECORD.
03 RSC-DATA.
07 RSC-CHAR PIC X(01)
OCCURS 1 TO 4500 TIMES
DEPENDING ON Rsc-Data-Length.
01 Rsc-Data-Length PIC 9(04) COMP.
01 Numero-Intentos PIC 9(04) COMP.
01 Estado-Comunicacion PIC 9(01).
01 Rsc-Command PIC S9(4) COMP.
01 Result-Sw Pic 9(04) Comp.
01 Ws-Reply Pic 9(04) Comp.
01 Ws-Server-Comunicaciones.
03 FILLER PIC X(08) VALUE "OSDRCOM-".
03 Ws-Log-Station-Number PIC X(04).
01 Ws-Server-Solicita-UMP Pic X(08) Value "OSATEPDT".
01 Ws-Server-Identifica-TID Pic X(08) Value "OSIDNTID".
01 Ws-Return-Term-Name Pic X(12).
01 Ws-Logical-Term-Name.
03 FILLER PIC X(08) VALUE "TERM-99-".
03 Ws-Log-Station-Number PIC X(04).
01 Ws-nombre-TID.
03 Ws-TID-X4 Pic X(04) Value "0000".
03 Filler Pic X(08) Value "CLRM1001".
COPY CODIGOS-AVI.
*----------------
01 Avi-Consulta-TID Pic S9(4) Comp Value 1002.
01 WS-SEND-SERVER-OSOCALLO PIC X(08) VALUE "OSOCALLO".
***********************************************************
* Estructuras de datos para la comunicacion con server *
* OSOCALLO, log errores. *
***********************************************************
01 WS-AREA-LOG-ERROR-APL.
COPY AREA-LOG-ERROR.
Copy Area-Var-Requester.
*------------------------
Copy Errores-Requester-WS.
*---------------------------
01 WS-AREA-LINK.
COPY AREA-LINK.
MESSAGE SECTION.
*================
01 RSC-MSG-ENT MESSAGE FORMAT IS DELIMITED
MESSAGE-DELIMITER IS OFF
FIELD-DELIMITER IS OFF.
07 RSC-STATUS-ENT PIC S9(04) COMP
TO Rsc-Command.
07 RSC-MESSAGE-RECORD-ENT PIC X(4500)
TO RSC-RECORD
RESULTING COUNT IS Rsc-Data-Length.
01 RSC-MSG-SAL MESSAGE FORMAT IS DELIMITED
MESSAGE-DELIMITER IS OFF
FIELD-DELIMITER IS OFF.
07 RSC-STATUS-SAL PIC S9(04) COMP
FROM Rsc-Command.
07 RSC-MESSAGE-RECORD PIC X(4500)
FROM RSC-RECORD
RESULTING COUNT IS Rsc-Data-Length.
PROCEDURE DIVISION.
*===================
* Enviamos un mensaje de Conexion al programa TCP/IP, quien
* nos responde si el SOCKET ya se encuentra conectado.
* de no ser asi, reintentamos un DELTA TE mas tarde.
Inicio.
*------
Move 0 to Numero-Intentos.
Move 1 to Estado-Comunicacion.
Move "FRAVISIN" to LS-NOMBRE-PROGRAMA.
Move LOGICAL-TERMINAL-NAME To Ws-Logical-Term-Name.
Move Ws-Log-Station-Number Of Ws-Logical-Term-Name
To Ws-Log-Station-Number Of Ws-Server-Comunicaciones
Ws-TID-X4.
Move Avi-Consulta-TID to WS-REPLY.
Perform Consulta-TID thru Consulta-TID-Exit.
Modulo-Principal.
*-----------------
Move 0 to Rsc-Data-Length.
Move Avi-Cod-Saludo to Rsc-Command.
If Numero-Intentos > 3
Go To Loop-Eterno.
Send Message RSC-MSG-SAL
Reply Yields RSC-MSG-ENT
On Error
Reconnect Modem
Delay 5
add 1 to Numero-Intentos
Go To Modulo-Principal.
*
* Esta alternativa no debiera ocurrir nunca, pero la colocamos por si acaso
*
IF Rsc-Command NOT = Avi-Rsp-Saludo
Delay 5
add 1 to Numero-Intentos
Go To Modulo-Principal.
* Lo ponemos en estado conectado y reseteamos el numero de intentos
Move 0 to Estado-Comunicacion
Move 0 to Numero-Intentos
Perform Loop-Eterno thru Loop-Eterno-Exit.
Loop-Eterno.
*-----------
* Si el UMP tiene un Error, dejaremos, por ahora, que se caiga
* el requestor.
Receive Unsolicited Message
Yields Ws-Area-Mensaje-Ump.
If WS-REPLY-CODE = Zero
Move Zero to Rsc-Data-Length
Move Avi-Cod-Aviso-Sin-UMP to Rsc-Command
Else
If WS-REPLY-CODE = 1
Move WS-MSGEN-NRO-BYTES-R1 of Ws-Msg-Ump-A-Los-Tid to Rsc-Data-Length
Add 1 To Rsc-Data-Length
Move WS-MSG-UMP-A-LOS-TID to Rsc-Record
Move Avi-Cod-UMP to Rsc-Command.
Loop-Eterno-1.
*------------
Send Message Rsc-Msg-Sal
Reply Yields Rsc-Msg-Ent
On Error
Move 2 To Ws-Ump-Code
Reply To Unsolicited Message With Ws-Ump-Code
*-- Perform Envia-Aviso-Server Thru Envia-Aviso-Server-Exit
Delay 1
Reconnect Modem
Go To Loop-Eterno.
If Rsc-Command = Avi-Rsp-UMP or Avi-Rsp-Aviso-Sin-UMP
Move 0 To Ws-Ump-Code
Reply To Unsolicited Message With Ws-Ump-Code
Else
* Es el caso de que el socket esta desconectado...
Move 1 To Ws-Ump-Code
Reply To Unsolicited Message With Ws-Ump-Code.
*-- Perform Envia-Aviso-Server Thru Envia-Aviso-Server-Exit.
Go To Loop-Eterno.
Loop-Eterno-Exit.
*----------------
Exit.
Envia-Aviso-Server.
*------------------
Perform Formar-Header-Stac Thru Formar-Header-Stac-Exit.
Begin-Transaction.
Move Zero to WS-REPLY.
Move Zero to Result-Sw.
Move Ws-Server-Solicita-UMP to Clr-Server-Name.
Send WS-REPLY
WS-MSGEN-HEADER-SINA Of WS-AREA-MENSAJE-ENTRADA-SINA
To Ws-Server-Solicita-UMP
Reply Code 0 1 2 Yields
WS-REPLY
WS-MSGEN-HEADER-SINA Of WS-AREA-MENSAJE-ENTRADA-SINA
WS-MSGEN-TEXTO-SINA Of WS-AREA-MENSAJE-ENTRADA-SINA
On Error
Move 1 to Result-Sw.
* If Result-Sw Not = Zero
* Hay que hacer algo, mientras tanto.....nada.....
End-Transaction.
Envia-Aviso-Server-Exit.
*-------------------------
Exit.
Consulta-TID.
*-------------
Begin-Transaction.
Move Ws-Server-Identifica-TID to Clr-Server-Name.
Move Zero to Result-Sw.
Send WS-REPLY
WS-LOGICAL-TERM-NAME
To Ws-Server-Identifica-TID
Reply
Code 0 Yields
WS-REPLY
Ws-Return-Term-Name
Ws-Nombre-TID
Code 1 Yields
WS-REPLY
On Error
Move 1 to Result-Sw.
If Result-Sw = Zero
Perform Clr-End-Transaction
Else
Move WS-LOGICAL-TERM-NAME To Ws-Nombre-TID
Perform Error-Server thru Error-Server-Exit
Stop Run.
* Respuesta:
* == 0: Todo O.K.
* <> 0: No se pudo encontrar el terminal en la BASE DE DATOS.
If WS-REPLY Not = 0
Move WS-LOGICAL-TERM-NAME To Ws-Nombre-TID
Move "Este Terminal no esta definido en las Tablas"
To Clr-CONSOLE-Message
Move "N" To Clr-CONSOLE-Action
Perform Do-Console-Log Thru Do-Console-Log-Exit
Stop Run.
*
Consulta-TID-Exit.
*------------------
Exit.
Copy Errores-Requester-PD.
*-------------------------
Formar-HEADER-STAC.
*---------------------
** 04 WS-MSGEN-HEADER-SINA PIC X(91).
Move all Space to WS-MSGEN-HEADER-SINA
Of WS-AREA-MENSAJE-ENTRADA-SINA.
Move 0000 to WS-MSGEN-NRO-BYTES-R1
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 00 to WS-MSGEN-NRO-BLQ-R1
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 0000 to WS-MSGEN-LARGO-TXT-R1
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 00 to WS-MSGEN-LARGO-COLA-R1
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move Ws-nombre-tid to WS-MSGEN-NOD-ORI
Of WS-AREA-MENSAJE-ENTRADA-SINA
* Move WS-FECHA to WS-MSGEN-FEC-ENT
* Of WS-AREA-MENSAJE-ENTRADA-SINA
* Move WS-HORA to WS-MSGEN-HOR-ENT
* Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 991212 to WS-MSGEN-FEC-ENT
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 245959 to WS-MSGEN-HOR-ENT
Of WS-AREA-MENSAJE-ENTRADA-SINA
MOVE 00000 to WS-MSGEN-NSE-R1
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 000 to WS-MSGEN-COD-MSG-R1
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move "x" to WS-MSGEN-TIP-MSG
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move "x" to WS-MSGEN-PRI-MSG
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move Ws-nombre-tid to WS-MSGEN-NOD-DES
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 991212 to WS-MSGEN-FEC-SAL
Of WS-AREA-MENSAJE-ENTRADA-SINA
Move 245959 to WS-MSGEN-HOR-SAL
Of WS-AREA-MENSAJE-ENTRADA-SINA
MOVE 00000 to WS-MSGEN-NSR-R1
Of WS-AREA-MENSAJE-ENTRADA-SINA.
Formar-HEADER-STAC-Exit.
*-----------------------
Exit.
Levanta-Comunicaciones.
*-----------------------
**
** Este parrafo se encarga de levantar el SOCKET, el cual le
** permitiria despertar al SOCKET para que este sea NONSTOP,
** ya que este debiera seguir poleando con el SCREEN.
**
MOVE Avi-Cod-Levanta TO Rsc-Command.
Move Ws-Server-Comunicaciones to Clr-Server-Name.
Send Rsc-Command
To Ws-Server-Comunicaciones
Reply
Code 0 101 102 103 104 105 301 304 305 306
Yields Rsc-Command
On Error
Perform Error-Levanta thru Error-Levanta-Exit
Delay 5
Go To Levanta-Comunicaciones.
Levanta-Comunicaciones-Exit.
*----------------------------
Exit.
Error-Levanta.
*-------------
Stop Run.
Error-Levanta-Exit.
*------------------
Exit.
ENVIA-CONSOLA.
*--------------
**
** Ciclo el cual se encarga de avisar a la consola los errores occurridos
** durante la ejecucion de la transaccion a nivel de SCREEN.
**
MOVE "FRTRNSIN" TO LS-NOMBRE-PROGRAMA.
** Ojo, que el tipo de error fue colocado en el llamado...
** MOVE "APL" TO LS-TIPO-ERROR.
**
SEND WS-AREA-LOG-ERROR-APL TO WS-SEND-SERVER-OSOCALLO
REPLY CODE 0 YIELDS WS-AREA-REPLY-CODE,
WS-AREA-LINK
ON ERROR
ADD 1 TO WS-REINTENTO.
IF TERMINATION-STATUS = 1
MOVE 4 TO WS-REINTENTO.
Write, Run & Share COBOL code online using OneCompiler's COBOL online compiler for free. It’s a reliable and accessible playground to practice and run COBOL code with ease. The compiler supports classic COBOL syntax and is great for learning, teaching, and experimenting with business logic programs.
COBOL (Common Business-Oriented Language) is a high-level programming language developed in the 1950s. It is primarily used in business, finance, and administrative systems for companies and governments. COBOL is known for its English-like syntax and is still widely used in legacy enterprise systems.
The following is a simple COBOL program that prints a greeting:
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
PROCEDURE DIVISION.
DISPLAY "Hello, OneCompiler!".
STOP RUN.
In COBOL, input is typically handled using the ACCEPT keyword. Here’s an example that takes user input and prints it back.
IDENTIFICATION DIVISION.
PROGRAM-ID. GREET.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 USER-NAME PIC A(30).
PROCEDURE DIVISION.
DISPLAY "Enter your name: ".
ACCEPT USER-NAME.
DISPLAY "Hello, " USER-NAME "!".
STOP RUN.
COBOL programs are divided into four divisions:
Variables are declared in the DATA DIVISION using PIC clauses.
01 AGE PIC 99.
01 NAME PIC A(20).
01 SALARY PIC 9(5)V99.
DISPLAY "Welcome to COBOL!".
ACCEPT USER-INPUT.
IF AGE >= 18
DISPLAY "Eligible to vote."
ELSE
DISPLAY "Not eligible."
END-IF.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 5
DISPLAY "Count: " I
END-PERFORM.
This guide provides a quick reference to COBOL programming syntax and features. Start coding in COBOL using OneCompiler’s COBOL online compiler today!