$TITLE('CobolGen V012BM07 === 052594')

NAME CobolGen

MODULE_DATA     SEGMENT WORD PUBLIC 'DATA'
VERSION_MODULE  DB      '012B07 CobolGen 052594'
MODULE_DATA     ENDS

;******************************* MODULE HEADER *******************************
;*									     *
;* MACHINE: B20B30	LANGUAGE: ASSEMBLER  OS: BTOS			     *
;*									     *
;*									     *
;*      CobolGen defines nonCOBOL procedures.				     *
;*									     *
;*									     *
;* HISTORY:								     *
;*									     *
;* 052594 012B.07 V 1.2   R.M. Abe    fix 3rd params for PREPARExSORT     *
;* 090993 012A.01 V 1.2   S.L. Ruiz   version 1.2 update.  		     *
;* 040991 011I.03 V 1.1   S.L. Ruiz   added 'AltRtn' macro.		     *
;* 031490 011A.01 V 1.1   C.Longridge with altered 'ExtrnRtn' macro.	     *
;*									     *
;*									     *
;*									     *
;* TITLE:  B20 SYSTEM SOFTWARE						     *
;*									     *
;*			PROPRIETARY PROGRAM MATERIAL			     *
;*									     *
;* THIS MATERIAL IS PROPRIETARY TO UNISYS  CORPORATION AND IS NOT TO BE	     *
;* REPRODUCED, USED OR DISCLOSED EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE   *
;* OR UPON WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF UNISYS	     *
;* CORPORATION, DETROIT, MICHIGAN 48232, USA.				     *
;*									     *
;* COPYRIGHT (C) 1990 UNISYS CORPORATION.				     *
;* ***************************************************************************
;*									     *
;* UNISYS    BELIEVES THAT THE SOFTWARE FURNISHED HEREWITH IS ACCURATE AND   *
;* RELIABLE, AND MUCH CARE HAS BEEN TAKEN IN ITS PREPARATION.  HOWEVER,	     *
;* NO RESPONSIBILITY, FINANCIAL OR OTHERWISE, CAN BE ACCEPTED FOR ANY	     *
;* CONSEQUENCES ARISING OUT OF THE USE OF THIS MATERIAL, INCLUDING LOSS OF   *
;* PROFIT, INDIRECT, SPECIAL, OR CONSEQUENTIAL DAMAGES, THERE ARE NO	     *
;* WARRANTIES WHICH EXTEND BEYOND THE PROGRAM SPECIFICATIONS.		     *
;*									     *
;* THE CUSTOMER SHOULD EXERCISE CARE TO ASSURE THAT USE OF THE SOFTWARE	     *
;* WILL BE IN FULL COMPLIANCE WITH LAWS, RULES AND REGULATIONS OF THE	     *
;* JURISDICTIONS WITH RESPECT TO WHICH IT IS USED.			     *
;*									     *
;*									     *
;*************************** END OF MODULE HEADER ****************************
;*****************************************************************************
;*		Copyright (C) Micro Focus Ltd. 1985			     *
;*****************************************************************************
;*    C R E A T E   N O N  C O B O L  P R O C E D U R E   T A B L E	     *
;*===========================================================================*
;*    This module is provided so that various nonCobol procedures	     *
;*    can be accessed by the Cobol runtime system. There are many	     *
;*    useful routines in this module. The inclusion of these routines	     *
;*    allows them to be CALLed by a COBOL program. They are not		     *
;*    meant to replace functions that can be readily accomplished	     *
;*    in Cobol.								     *
;*									     *
;*    These routines are accessed from Cobol as follows :		     *
;*									     *
;*		Call PROCEDURE Using aParam, bParam, ...		     *
;*									     *
;*    A new procedure is added by including the procedure definition	     *
;*    as follows:							     *
;*									     *
;*    ExtrnRtn (Name Of Procedure, Return Type, Screen Type,		     *
;*		No Of Parameters, Parameters)				     *
;*									     *
;*    RETURN TYPE can take the following values:			     *
;*	x  No Return type						     *
;*	b  A Byte value is returned					     *
;*	w  A Word value is returned					     *
;*	q  A Quad value is returned (double wordpointer)		     *
;*									     *
;*    SCREEN TYPE can be 0 or 1.					     *
;*	0  Does not affect the video display				     *
;*	1  affects the use the video display				     *
;*									     *
;*    PARAMETERS can be any of the following types:			     *
;*	x  points to some bytes or a structure				     *
;*	b  a byte							     *
;*	w  a word							     *
;*	q  a quad (double wordpointer)				     *
;*	y  points to a word						     *
;*	z  points to a quad 						     *
;*									     *
;*    To help in the use of this facility the procedure name must be	     *
;*    upper case.							     *
;*									     *
;*    When this module is assembled, a Y reply to a prompt will cause	     *
;*    that procedure to be included. An N respondse to the prompt	     *
;*    will exclude that procedure (RETURN may be pressed instead of	     *
;*    N).								     *
;**
;*    For a more complete explanation of how to use this facility, see	     *
;*    the COBOL2 Operating Guide.					     *
;*===========================================================================*

DGROUP	group	MODULE_DATA, DSEG
FGROUP	group	INSTALLF
	extrn	btos_call	:far

;*****************************************************************************
;*	Macro 'ExtrnRtn'.						     *
;*****************************************************************************
;*	This macro allows definition of a table of structures, one for	     *
;*	each of the non Cobol routines called by the RTS.		     *
;*****************************************************************************
*define (ExtrnRtn(nam,rtyp,styp,npms,pms))
(define (tbf)(pms) define (fulnam)(nam)	extrn	nam:far
COBOLGEN segment byte public 'CODE'
public	@nam
@nam	label byte
	call	btos_call
	dd	nam
	db	'rtyp'
	db	styp
	db	npms while(len(tbf) gt 0)(match(tof,tbf)(tbf)
	db	'tof')
COBOLGEN ends

INSTALLF segment word	public	'INSTALLF'
	even
	dd	0ffffffffh
	dd	0ffffffffh
	dd	@nam
	db	0
	db	len(fulnam)
	db	'fulnam'
INSTALLF ENDS)
;*****************************************************************************
;*	End Macro							     *
;*****************************************************************************

;*****************************************************************************
;*	Macro 'AltRtn'.							     *
;*****************************************************************************
;*	This macro allows definition of a table of structures, one for	     *
;*	each of the non Cobol routines called by the RTS.		     *
;*	The difference from 'ExtrnRtn' is that it is possible to have	     *
;*	a target routine with a different name.				     *
;*****************************************************************************
*define (AltRtn(nam,altnam,rtyp,styp,npms,pms))
(define (tbf)(pms) define (fulnam)(nam)	extrn	altnam:far
COBOLGEN segment byte public 'CODE'
public	@nam
@nam	label byte
	call	btos_call
	dd	altnam
	db	'rtyp'
	db	styp
	db	npms while(len(tbf) gt 0)(match(tof,tbf)(tbf)
	db	'tof')
COBOLGEN ends

INSTALLF segment word	public	'INSTALLF'
	even
	dd	0ffffffffh
	dd	0ffffffffh
	dd	@nam
	db	0
	db	len(fulnam)
	db	'fulnam'
INSTALLF ENDS)
;*****************************************************************************
;*	End Macro							     *
;*****************************************************************************

DSEG	segment	byte	public	'RTSDATA'

	public	VID_SUPPRESS	; Full screen control byte
	public	EXT_BYTES   	; External ShortLived Memory default size

DSEG	ENDS

;*****************************************************************************
;*	Please add your procedure definitions here			     *
;*****************************************************************************

'  ExtrnRtn(ALONGPROCEDURENAME,x,0,10,w,w,w,b,b,b,q,q,q,p)  Example

;*****************************************************************************
;*	End of user defined procedures					     *
;*****************************************************************************

;*****************************************************************************
;* NonCobol routines required by BTOS Cobol for setting up parameters	     *
;* for calls to BTOS os routines.					     *
;*****************************************************************************
ExtrnRtn(GETPOINTER,q,0,1,x)
ExtrnRtn(WORDALIGNED,b,0,1,x)
ExtrnRtn(MAKEPOINTER,q,0,2,w,w)
ExtrnRtn(CONVERTWORD,x,0,2,w,x)
ExtrnRtn(CONVERTQUAD,x,0,2,q,x)
ExtrnRtn(UNMAKEPOINTER,x,0,3,q,x,x)
ExtrnRtn(GETDATETIMEDAY,x,0,3,x,x,x)
AltRtn(CTOSWAIT,WAIT,w,0,2,w,z)
;*****************************************************************************
;*	Below are the system routines which can be included		     *
;*****************************************************************************
if(pass1 eq 1) then (
out(
BTOS COBOLGEN  COBOL2 1.0
)
	out(
Will you be calling BTOS ORACLE (yn)? )
	define(aORACLE)(in)
	set(bORACLE,0)
	if (eqs(substr(aORACLE,1,1),Y)) then (set(bORACLE,1)) fi
	if (eqs(substr(aORACLE,1,1),y)) then (set(bORACLE,1)) fi
	out(
Will you be calling Graphics routines (yn)? )
	define(aGRAPHICS)(in)
	set(bGRAPHICS,0)
	if (eqs(substr(aGRAPHICS,1,1),Y)) then (set(bGRAPHICS,1)) fi
	if (eqs(substr(aGRAPHICS,1,1),y)) then (set(bGRAPHICS,1)) fi
	out(
Will you be calling BTOS FORMS (yn)? )
	define(aFORMS)(in)
	set(bFORMS,0)
	if (eqs(substr(aFORMS,1,1),Y)) then (set(bFORMS,1)) fi
	if (eqs(substr(aFORMS,1,1),y)) then (set(bFORMS,1)) fi
	out(
Will you be calling TAPE (yn)? )
	define(aTAPE)(in)
	set(bTAPE,0)
	if (eqs(substr(aTAPE,1,1),Y)) then (set(bTAPE,1)) fi
	if (eqs(substr(aTAPE,1,1),y)) then (set(bTAPE,1)) fi
	out(
Will you be calling BTOS OpenFile or CloseFile (yn)? )
	define(aBTOSoc)(in)
	set(bBTOSoc,0)
	if (eqs(substr(aBTOSoc,1,1),Y)) then (set(bBTOSoc,1)) fi
	if (eqs(substr(aBTOSoc,1,1),y)) then (set(bBTOSoc,1)) fi
	out(
Will you be calling BTOS File Management (yn)? )
	define(aBTOSfm)(in)
	set(bBTOSfm,0)
	if (eqs(substr(aBTOSfm,1,1),Y)) then (set(bBTOSfm,1)) fi
	if (eqs(substr(aBTOSfm,1,1),y)) then (set(bBTOSfm,1)) fi
	out(
Will you be calling the Record Sequential Access Method (yn)? )
	define(aRSAM)(in)
	set(bRSAM,0)
	if (eqs(substr(aRSAM,1,1),Y)) then (set(bRSAM,1)) fi
	if (eqs(substr(aRSAM,1,1),y)) then (set(bRSAM,1)) fi
	out(
Will you be calling the Video Access Method (yn)? )
	define(aVAM)(in)
	set(bVAM,0)
	if (eqs(substr(aVAM,1,1),Y)) then (set(bVAM,1)) fi
	if (eqs(substr(aVAM,1,1),y)) then (set(bVAM,1)) fi
	out(
Will you be calling the Video Display Manager (yn)? )
	define(aVDM)(in)
	set(bVDM,0)
	if (eqs(substr(aVDM,1,1),Y)) then (set(bVDM,1)) fi
	if (eqs(substr(aVDM,1,1),y)) then (set(bVDM,1)) fi
	out(
Will you be calling BTOS Keyboard Management (yn)? )
	define(aBTOSkm)(in)
	set(bBTOSkm,0)
	if (eqs(substr(aBTOSkm,1,1),Y)) then (set(bBTOSkm,1)) fi
	if (eqs(substr(aBTOSkm,1,1),y)) then (set(bBTOSkm,1)) fi
	out(
Will you be calling BTOS Parameter Management (yn)? )
	define(aBTOSpm)(in)
	set(bBTOSpm,0)
	if (eqs(substr(aBTOSpm,1,1),Y)) then (set(bBTOSpm,1)) fi
	if (eqs(substr(aBTOSpm,1,1),y)) then (set(bBTOSpm,1)) fi
	out(
Will you be calling BTOS Memory Management (ynm)? )
	define(aBTOSmm)(in)
	set(bBTOSmm,0)
	if (eqs(substr(aBTOSmm,1,1),Y)) then (set(bBTOSmm,1)) fi
	if (eqs(substr(aBTOSmm,1,1),y)) then (set(bBTOSmm,1)) fi
	if (eqs(substr(aBTOSmm,1,1),M)) then (set(bBTOSmm,2)) fi
	if (eqs(substr(aBTOSmm,1,1),m)) then (set(bBTOSmm,2)) fi
	out(
Will you be calling BTOS Task Management (yn)? )
	define(aBTOStm)(in)
	set(bBTOStm,0)
	if (eqs(substr(aBTOStm,1,1),Y)) then (set(bBTOStm,1)) fi
	if (eqs(substr(aBTOStm,1,1),y)) then (set(bBTOStm,1)) fi
	out(
Will you be calling BTOS Contingency Management (yn)? )
	define(aBTOSgm)(in)
	set(bBTOSgm,0)
	if (eqs(substr(aBTOSgm,1,1),Y)) then (set(bBTOSgm,1)) fi
	if (eqs(substr(aBTOSgm,1,1),y)) then (set(bBTOSgm,1)) fi
	out(
Will you be calling BTOS Exchange Management (yn)? )
	define(aBTOSem)(in)
	set(bBTOSem,0)
	if (eqs(substr(aBTOSem,1,1),Y)) then (set(bBTOSem,1)) fi
	if (eqs(substr(aBTOSem,1,1),y)) then (set(bBTOSem,1)) fi
	out(
Will you be calling BTOS Queue Management (yn)? )
	define(aBTOSqm)(in)
	set(bBTOSqm,0)
	if (eqs(substr(aBTOSqm,1,1),Y)) then (set(bBTOSqm,1)) fi
	if (eqs(substr(aBTOSqm,1,1),y)) then (set(bBTOSqm,1)) fi
	out(
Will you be calling BTOS Printer Spooler Management (yn)? )
	define(aBTOSsm)(in)
	set(bBTOSsm,0)
	if (eqs(substr(aBTOSsm,1,1),Y)) then (set(bBTOSsm,1)) fi
	if (eqs(substr(aBTOSsm,1,1),y)) then (set(bBTOSsm,1)) fi
	out(
Will you be calling BTOS Timer Management (yn)? )
	define(aBTOScm)(in)
	set(bBTOScm,0)
	if (eqs(substr(aBTOScm,1,1),Y)) then (set(bBTOScm,1)) fi
	if (eqs(substr(aBTOScm,1,1),y)) then (set(bBTOScm,1)) fi
	out(
*************************************************************************
* Note:	COBOL2 provides access to file facilities from within the	*
*	COBOL language.							*
*	It is possible, but not mandatory to use nonCOBOL calls to	*
*	access some of these facilities.				*
*	Listed below are the COBOL language features equivalent to	*
*	each of the file facilities you may want to use.		*
*************************************************************************
*      Isam ......................... COBOL Indexed files		*
*      Sequential Access Method ..... COBOL Sequential files		*
*************************************************************************
)
	out(
Will you be calling ISAM (yn)? )
	define(aISAM)(in)
	set(bISAM,0)
	if (eqs(substr(aISAM,1,1),Y)) then (set(bISAM,1)) fi
	if (eqs(substr(aISAM,1,1),y)) then (set(bISAM,1)) fi
	out(
Will you be calling the Sequential Access Method (yn)? )
	define(aSAM)(in)
	set(bSAM,0)
	if (eqs(substr(aSAM,1,1),Y)) then (set(bSAM,1)) fi
	if (eqs(substr(aSAM,1,1),y)) then (set(bSAM,1)) fi
	out(
*************************************************************************
*	The BTOS facilities listed below can not be accessed using	*
*	COBOL language syntax in this product. 				*
*************************************************************************
*      BTOS Direct Access Method					*
*      BTOS SortMerge 							*
*************************************************************************
* Note:	COBOL2 contains its own SortMerge package which is always	*
*	available using Cobol language syntax.				*
*************************************************************************
*	Answering yes to the following questions will allow access to	*
*	the BTOS facilities via nonCobol calls.			*
*************************************************************************

Will you be calling the Direct Access Method (yn)? )
	define(aDAM)(in)
	set(bDAM,0)
	if (eqs(substr(aDAM,1,1),Y)) then (set(bDAM,1)) fi
	if (eqs(substr(aDAM,1,1),y)) then (set(bDAM,1)) fi
	out(
Will you be calling SortMerge (yn)? )
	define(aSM)(in)
	set(bSM,0)
	if (eqs(substr(aSM,1,1),Y)) then (set(bSM,1)) fi
	if (eqs(substr(aSM,1,1),y)) then (set(bSM,1)) fi
	out(
*************************************************************************
*	Answering yes to the next question will cause COBOL2 to	*
*	automatically clear the top 3 Executive lines when running	*
*	COBOL applications, thus making the full screen available.	*
*************************************************************************

Will you be using the full video screen size (yn)? )
	define(aFS)(in)
	set(bFS,1)
	if (eqs(substr(aFS,1,1),Y)) then (set(bFS,0)) fi
	if (eqs(substr(aFS,1,1),y)) then (set(bFS,0)) fi

out(
 ..... configuring COBOL2 1.2)
) fi
if (bORACLE eq 1) then (
$Title( BTOS ORACLE) Eject
	ExtrnRtn(SQLAB1,x,0,1,x)
	ExtrnRtn(SQLAB2,x,0,5,x,x,x,x,x)
	ExtrnRtn(SQLADR,x,0,2,x,x)
	ExtrnRtn(SQLAD1,x,0,1,x)
	ExtrnRtn(SQLAD2,x,0,5,x,x,x,x,x)
	ExtrnRtn(SQLBS1,x,0,3,x,x,x)
	ExtrnRtn(SQLBS2,x,0,7,x,x,x,x,x,x,x)
	ExtrnRtn(SQLCLS,x,0,1,x)
	ExtrnRtn(SQLCLU,x,0,1,x)
	ExtrnRtn(SQLCOM,x,0,1,x)
	ExtrnRtn(SQLEXE,x,0,1,x)
	ExtrnRtn(SQLFCC,x,0,0)
	ExtrnRtn(SQLFCH,x,0,2,x,x)
	ExtrnRtn(SQLGB1,x,0,1,x)
	ExtrnRtn(SQLGB2,x,0,9,x,x,x,x,x,x,x,x,x)
	ExtrnRtn(SQLGD1,x,0,1,x)
	ExtrnRtn(SQLGD2,x,0,7,x,x,x,x,x,x,x)
	ExtrnRtn(SQLGF1,x,0,2,x,x)
	ExtrnRtn(SQLGF2,x,0,8,x,x,x,x,x,x,x,x)
	ExtrnRtn(SQLGMS,x,0,1,x)
	ExtrnRtn(SQLIEM,x,0,2,x,x)
	ExtrnRtn(SQLLO1,x,0,5,x,x,x,x,x)
	ExtrnRtn(SQLLO2,x,0,8,x,x,x,x,x,x,x,x)
	ExtrnRtn(SQLLDA,x,0,1,x)
	ExtrnRtn(SQLLEN,x,0,1,x)
	ExtrnRtn(SQLOCA,x,0,4,x,x,x,x)
	ExtrnRtn(SQLOPN,x,0,3,x,x,x)
	ExtrnRtn(SQLOS1,x,0,1,x)
	ExtrnRtn(SQLOS2,x,0,5,x,x,x,x,x)
	ExtrnRtn(SQLOSQ,x,0,2,x,x)
	ExtrnRtn(SQLPCS,x,0,2,x,x)
	ExtrnRtn(SQLPF1,x,0,2,x,x)
	ExtrnRtn(SQLPF2,x,0,8,x,x,x,x,x,x,x,x)
	ExtrnRtn(SQLROL,x,0,1,x)
	ExtrnRtn(SQLSCA,x,0,1,x)
	ExtrnRtn(SQLSCC,x,0,1,x)
	ExtrnRtn(SQLSCH,x,0,1,x)
	ExtrnRtn(SQLSQS,x,0,2,x,x)
	ExtrnRtn(SQLTFL,x,0,2,x,x)
	ExtrnRtn(SQLWNR,x,0,0)
	ExtrnRtn(SQLGRI,x,0,2,x,x)
	ExtrnRtn(SQLBCC,x,0,2,x,x)

) fi
if (bGraphics eq 1) then (
$Title( Graphics ) Eject
	ExtrnRtn(CLEARSCREEN,w,0,0)
	ExtrnRtn(CLEARSCREENRECTANGLE,w,0,4,w,w,w,w)
	ExtrnRtn(DRAWSCREENARC,w,0,7,w,w,w,w,w,w,w)
	ExtrnRtn(DRAWSCREENLINE,w,0,4,w,w,w,w)
	ExtrnRtn(FILLSCREENRECTANGLE,w,0,5,w,w,w,w,b)
	ExtrnRtn(GETDRAWATTRINFO,w,0,1,x)
	ExtrnRtn(GETRASTERINFO,w,0,1,x)
'	ExtrnRtn(INITADDITIONALGRAPHICSSCREEN,w,0,0)
	ExtrnRtn(INITSCREENGRAPHICS,w,0,0)
	ExtrnRtn(LOADCOLOR,w,0,3,w,w,b)
	ExtrnRtn(LOADCOLORMAPPER,w,0,2,w,x)
	ExtrnRtn(LOADSOFTPATTERN,w,0,2,w,w)
'  	ExtrnRtn(MAPGRAPHICSWINDOW,w,0,1,y)
'	ExtrnRtn(READPIXELCOLOR,w,0,3,w,w,x)
'	ExtrnRtn(RETURNGRAPHICSSCREEN,w,0,0)
	ExtrnRtn(SETCOLORMAPPER,w,0,1,w)
	ExtrnRtn(SETCOMMANDSCREEN,w,0,1,w)
	ExtrnRtn(SETSCREENCOLOR,w,0,1,w)
	ExtrnRtn(SETSCREENDRAWINGMODE,w,0,1,w)
	ExtrnRtn(SETSCREENLINETYPE,w,0,1,w)
	ExtrnRtn(SETVISIBLESCREEN,w,0,1,w)
	ExtrnRtn(TURNOFFGRAPHICS,w,0,0)
	ExtrnRtn(TURNOFFGRAPHICSCOLOR,w,0,0)
	ExtrnRtn(TURNONGRAPHICS,w,0,0)
	ExtrnRtn(TURNONGRAPHICSCOLOR,w,0,0)
) fi
if (bFORMS eq 1) then (
$Title( Forms Package) Eject
	ExtrnRtn(LOCKKBD,w,0,0)
	ExtrnRtn(OPENFORM,w,0,5,w,x,w,x,w)
	ExtrnRtn(READFIELD,w,1,8,x,x,w,w,x,w,y,x)
	ExtrnRtn(WRITEFIELD,w,1,7,x,x,w,w,x,w,x)
	ExtrnRtn(DEFAULTFORM,w,1,1,x)
	ExtrnRtn(DISPLAYFORM,w,1,4,x,w,w,w)
	ExtrnRtn(DEFAULTFIELD,w,1,4,x,x,w,w)
	ExtrnRtn(GETFIELDINFO,w,0,6,x,x,w,w,x,w)
	ExtrnRtn(SETFIELDATTRS,w,1,5,x,x,w,w,w)
	ExtrnRtn(UNDISPLAYFORM,w,1,1,x)
	ExtrnRtn(USERFILLFIELD,w,1,6,x,x,w,w,x,x)
	ExtrnRtn(EDITFORM,w,1,13,x,w,x,w,x,w,x,w,w,w,w,x,w)
	ExtrnRtn(TYPEFORM,w,1,7,x,x,w,x,w,w,x)
	ExtrnRtn(RESTOREFORM,w,1,3,x,x,w)
	ExtrnRtn(OUTFORM,w,1,9,x,w,x,w,x,w,x,w,x)
	ExtrnRtn(FONCTFORM,w,0,2,x,w)
	ExtrnRtn(STOREFIELDDATA,w,0,9,x,x,w,w,x,x,w,x,x)
	ExtrnRtn(SETFIELDTYPE,w,0,6,x,w,x,w,w,w)
	ExtrnRtn(ADDVALUES,w,1,8,x,w,x,w,x,w,x,w)
	ExtrnRtn(EXTRACTVALUES,w,0,7,x,w,x,w,x,w,x)

) fi
if (bTAPE eq 1) then (
$Title( TAPE Management)  Eject
	ExtrnRtn(CLOSETAPE,w,0,1,w)
	ExtrnRtn(OPENTAPE,w,0,7,x,w,b,b,b,w,y)
	ExtrnRtn(PURGETAPEUSER,w,0,1,w)
	ExtrnRtn(READTAPERECORDS,w,0,6,w,w,x,w,y,y)
	ExtrnRtn(TAPEOPERATION,w,0,4,w,b,b,w)
	ExtrnRtn(TAPESTATUS,w,0,2,w,y)
	ExtrnRtn(WRITETAPERECORDS,w,0,6,w,w,x,w,y,y)
) fi
if (bISAM eq 1) then (
$Title( ISAM Package) Eject
	ExtrnRtn(CLOSEISAM,w,0,2,w,x)
	ExtrnRtn(CREATEISAM,w,0,11,x,w,x,w,x,w,x,w,x,w,x)
	ExtrnRtn(DELETEISAM,w,0,2,w,x)
	ExtrnRtn(DELETEISAMRECORD,w,0,3,w,q,x)
	ExtrnRtn(DELETEISAMRECORDBYKEY,w,0,6,w,w,x,w,z,x)
'	ExtrnRtn(ENDISAMTRANSACTION,w,0,1,x)
	ExtrnRtn(GETISAMRECORDS,w,0,6,w,b,x,w,y,x)
	ExtrnRtn(GETISAMRECORDSHOLD,w,0,6,w,b,x,w,y,x)
'	ExtrnRtn(GETISAMFILESTATUS,w,0,6,w,x,x,w,y,x)
	ExtrnRtn(HOLDISAMDATASET,w,0,3,w,b,x)
	ExtrnRtn(HOLDISAMRECORD,w,0,3,w,q,x)
	ExtrnRtn(ISAMREQUEST,w,0,1,x)
	ExtrnRtn(LOADSINGLEUSERISAM,w,0,9,x,w,x,w,x,w,x,w,x)
'	ExtrnRtn(LOCKISAM,w,0,4,w,x,w,x)    
	ExtrnRtn(MODIFYISAMRECORD,w,0,5,w,q,x,w,x)
	ExtrnRtn(MODIFYISAMRECORDBYKEY,w,0,6,w,w,x,w,z,x)
	ExtrnRtn(NORMALIZEISAMSTATUS,w,0,1,x)
	ExtrnRtn(OPENISAM,w,0,8,y,x,w,x,w,w,w,x)
'	ExtrnRtn(PURGEISAMTRANSACTION,w,0,1,x)
	ExtrnRtn(READISAMRECORDBYURI,w,0,5,w,q,x,w,x)
	ExtrnRtn(READISAMRECORDBYURIHOLD,w,0,5,w,q,x,w,x)
	ExtrnRtn(READNEXTISAMRECORD,w,0,5,w,x,w,z,x)
	ExtrnRtn(READNEXTISAMRECORDHOLD,w,0,5,w,x,w,z,x)
	ExtrnRtn(READUNIQUEISAMRECORD,w,0,8,w,w,x,w,x,w,z,x)
	ExtrnRtn(READUNIQUEISAMRECORDHOLD,w,0,8,w,w,x,w,x,w,z,x)
	ExtrnRtn(RELEASEISAMDATASET,w,0,2,w,x)
	ExtrnRtn(RELEASEISAMRECORD,w,0,3,w,q,x)
	ExtrnRtn(RELEASEISAMRECSFORUSER,w,0,2,w,x)
	ExtrnRtn(RENAMEISAM,w,0,10,w,x,w,x,w,x,w,x,w,x)
	ExtrnRtn(SETISAMPROTECTION,w,0,6,w,x,w,x,w,x)
'	ExtrnRtn(SETUPISAMITERATION,w,0,5,w,w,x,w,x)
'	ExtrnRtn(SETUPISAMITERATIONKEY,w,0,5,w,w,x,w,x)
	ExtrnRtn(SETUPISAMITERATIONLIMITS,w,0,8,w,w,w,x,w,x,w,x)
	ExtrnRtn(SETUPISAMITERATIONPREFIX,w,0,5,w,w,x,w,x)
'	ExtrnRtn(SETUPISAMITERATIONRANGE,w,0,9,w,w,x,w,b,x,w,b,x)
'	ExtrnRtn(STARTISAMTRANSACTION,w,0,5,b,w,x,w,x)
	ExtrnRtn(STOREISAMRECORD,w,0,5,w,x,w,z,x)
'	ExtrnRtn(UNLOCKISAM,w,0,1,x)
	ExtrnRtn(VERIFYMULTIUSERISAM,w,0,3,x,w,x)
	ExtrnRtn(BEGINTRANSACTION,w,0,1,x)
	ExtrnRtn(COMMITTRANSACTION,w,0,1,x)
	ExtrnRtn(QUERYTRANSACTIONPARAMS,w,0,4,x,w,y,x)
	ExtrnRtn(ROLLBACKTRANSACTION,w,0,1,x)
	ExtrnRtn(SETTRANSACTIONPARAMS,w,0,3,x,w,x)
) fi
if (bSAM eq 1) then (
$Title( Sequential Access Method) Eject
	ExtrnRtn(CHECKPOINTBS,w,0,1,x)
	ExtrnRtn(CLOSEBYTESTREAM,w,0,1,x)
	ExtrnRtn(GETBSLFA,w,0,2,x,z)
	ExtrnRtn(OPENBYTESTREAM,w,0,8,x,x,w,x,w,w,x,w)
	ExtrnRtn(PUTBACKBYTE,w,0,2,x,b)
	ExtrnRtn(QUERYVIDBS,w,0,2,x,x)
	ExtrnRtn(READBSRECORD,w,0,4,x,x,w,y)
	ExtrnRtn(READBYTE,w,0,2,x,x)
	ExtrnRtn(READBYTES,w,0,4,x,w,z,y)
	ExtrnRtn(RELEASEBYTESTREAM,w,0,1,x)
	ExtrnRtn(SETBSLFA,w,0,2,x,q)
	ExtrnRtn(SETIMAGEMODE,w,0,2,x,w)
	ExtrnRtn(WRITEBSRECORD,w,0,4,x,x,w,y)
	ExtrnRtn(WRITEBYTE,w,0,2,x,b)
) fi
if (bDAM eq 1) then (
$Title( Direct Access Method)  Eject
	ExtrnRtn(CLOSEDAFILE,w,0,1,x)
	ExtrnRtn(DELETEDARECORD,w,0,2,x,q)
	ExtrnRtn(OPENDAFILE,w,0,9,x,x,w,x,w,w,x,w,w)
	ExtrnRtn(QUERYDALASTRECORD,w,0,2,x,z)
	ExtrnRtn(QUERYDARECORDSTATUS,w,0,3,x,q,y)
	ExtrnRtn(READDAFRAGMENT,w,0,5,x,q,x,w,w)
	ExtrnRtn(READDARECORD,w,0,3,x,q,x)
	ExtrnRtn(SETDABUFFERMODE,w,0,2,x,w)
	ExtrnRtn(TRUNCATEDAFILE,w,0,2,x,q)
	ExtrnRtn(WRITEDAFRAGMENT,w,0,5,x,q,x,w,w)
	ExtrnRtn(WRITEDARECORD,w,0,3,x,q,x)
) fi
if (bSM eq 1) then (
$Title( SortMerge Package) Eject
	ExtrnRtn(DOSORT,w,0,1,x)
        ExtrnRtn(CONCLUDESORT,w,0,1,x)  ; 072387
	ExtrnRtn(PREPARESORT,w,0,4,x,y,x,x)
	ExtrnRtn(RETURNRECORD,w,0,3,y,x,x)
	ExtrnRtn(TERMINATESORT,w,0,1,x)
	ExtrnRtn(RELEASERECORD,w,0,3,y,x,x)
	ExtrnRtn(PREPAREKEYSORT,w,0,4,x,x,x,x)
	ExtrnRtn(RETURNRECORDANDKEY,w,0,5,y,x,y,x,x)
	ExtrnRtn(RELEASERECORDANDKEY,w,0,5,y,x,y,x,x)
) fi
if (bRSAM eq 1) then (
$Title( Record Sequential Access Method) Eject
	ExtrnRtn(GETSTAMFILEHEADER,w,0,5,x,w,x,w,x)
	ExtrnRtn(CHECKPOINTRSFILE,w,0,1,x)
	ExtrnRtn(CLOSERSFILE,w,0,1,x)
	ExtrnRtn(GETRSLFA,w,0,2,x,z)
	ExtrnRtn(OPENRSFILE,w,0,8,x,x,w,x,w,w,q,w)
	ExtrnRtn(READRSRECORD,w,0,4,x,x,w,y)
	ExtrnRtn(RELEASERSFILE,w,0,1,x)
	ExtrnRtn(SCANTOGOODRSRECORD,w,0,4,x,q,z,z)
	ExtrnRtn(WRITERSRECORD,w,0,3,x,x,w)
) fi
if (bVAM eq 1) then (
$Title( Video Access Method)  Eject
	ExtrnRtn(POSFRAMECURSOR,w,0,3,w,w,w)
	ExtrnRtn(PUTFRAMEATTRS,w,0,5,w,w,w,w,w)
	ExtrnRtn(PUTFRAMECHARS,w,0,5,w,w,w,x,w)
	ExtrnRtn(QUERYFRAMECHAR,w,0,4,w,w,w,x)
	ExtrnRtn(RESETFRAME,w,0,1,w)
	ExtrnRtn(SCROLLFRAME,w,0,5,w,w,w,w,b)
) fi
if (bVDM eq 1) then (
$Title( Video Display Manager)  Eject
	ExtrnRtn(INITCHARMAP,w,0,2,q,w)
	ExtrnRtn(INITVIDFRAME,w,0,10,w,w,w,w,w,b,b,b,b,b)
	ExtrnRtn(LOADCURSORRAM,w,0,2,x,w)
	ExtrnRtn(LOADFONTRAM,w,0,3,w,q,w)
	ExtrnRtn(LOADSTYLERAM,w,0,2,x,w)
	ExtrnRtn(QUERYVIDHDW,w,0,2,x,w)
	ExtrnRtn(RESETVIDEO,w,0,5,w,w,b,b,y)
	ExtrnRtn(SETSCREENVIDATTR,w,0,2,w,b)
	ExtrnRtn(LOADCOLORSTYLERAM,w,0,1,x)
'	ExtrnRtn(LOADSTYLERAMENTRY,w,0,2,w,b)
	ExtrnRtn(SETSTYLERAM,w,0,1,b)
) fi
if (bBTOSmm eq 1) then (
$Title( BTOS Memory Management)  Eject
	ExtrnRtn(ALLOCALLMEMORYSL,w,0,2,y,z)
	ExtrnRtn(ALLOCMEMORYLL,w,0,2,w,z)
	ExtrnRtn(ALLOCMEMORYSL,w,0,2,w,z)
	ExtrnRtn(DEALLOCMEMORYLL,w,0,2,q,w)
	ExtrnRtn(DEALLOCMEMORYSL,w,0,2,q,w)
	ExtrnRtn(RESETMEMORYLL,w,0,0)
	ExtrnRtn(QUERYMEMAVAIL,w,0,1,y)
) else
(if (bBTOSmm eq 2) then (
$Title( BTOS Memory Management  Alternate AllocDeallocMemorySL)  Eject
	ExtrnRtn(ALLOCALLMEMORYSL,w,0,2,y,z)
	ExtrnRtn(ALLOCMEMORYLL,w,0,2,w,z)
	AltRtn(ALLOCMEMORYSL,COBALLOCSL,w,0,2,w,z)
	ExtrnRtn(DEALLOCMEMORYLL,w,0,2,q,w)
	AltRtn(DEALLOCMEMORYSL,COBDEALLOCSL,w,0,2,q,w)
	ExtrnRtn(RESETMEMORYLL,w,0,0)
	ExtrnRtn(QUERYMEMAVAIL,w,0,1,y)
) fi ) fi
if (bBTOSoc eq 1) then (
$Title( BTOS OpenFileCloseFile)  Eject
	ExtrnRtn(CLOSEFILE,w,0,1,w)
	ExtrnRtn(OPENFILE,w,0,6,y,x,w,x,w,w)
) fi
if (bBTOSfm eq 1) then (
$Title( BTOS File Management)  Eject
	ExtrnRtn(CHANGEFILELENGTH,w,0,2,w,q)
	ExtrnRtn(CHECKREADASYNC,w,0,2,x,y)
	ExtrnRtn(CHECKWRITEASYNC,w,0,2,x,y)
	ExtrnRtn(CLEARPATH,w,0,0)
	ExtrnRtn(CLOSEALLFILES,w,0,0)
	ExtrnRtn(CLOSEALLFILESLL,w,0,0)
	ExtrnRtn(CREATEDIR,w,0,8,x,w,x,w,x,w,w,w)
	ExtrnRtn(CREATEFILE,w,0,5,x,w,x,w,q)
	ExtrnRtn(DELETEDIR,w,0,4,x,w,x,w)
	ExtrnRtn(DELETEFILE,w,0,1,w)
	ExtrnRtn(GETFHLONGEVITY,w,0,2,w,y)
	ExtrnRtn(GETVHB,w,0,4,x,w,x,w)
	ExtrnRtn(GETFILESTATUS,w,0,4,w,w,x,w)
	ExtrnRtn(GETUCB,w,0,2,x,w)
	ExtrnRtn(OPENFILELL,w,0,6,y,x,w,x,w,w)
	ExtrnRtn(QUERYWSNUM,w,0,1,y)
	ExtrnRtn(READ,w,0,5,w,x,w,q,y)
	ExtrnRtn(READASYNC,w,0,6,w,x,w,q,x,w)
	ExtrnRtn(READDIRSECTOR,w,0,6,x,w,x,w,w,x)
	ExtrnRtn(RENAMEFILE,w,0,5,w,x,w,x,w)
	ExtrnRtn(SETFHLONGEVITY,w,0,2,w,w)
	ExtrnRtn(SETFILESTATUS,w,0,4,w,w,x,w)
	ExtrnRtn(SETPATH,w,0,6,x,w,x,w,x,w)
	ExtrnRtn(SETPREFIX,w,0,2,x,w)
	ExtrnRtn(WRITE,w,0,5,w,x,w,q,y)
	ExtrnRtn(WRITEASYNC,w,0,6,w,x,w,q,x,w)
) fi
if (bBTOSkm eq 1) then (
$Title( BTOS Keyboard Management)  Eject
	ExtrnRtn(BEEP,w,0,0)
	ExtrnRtn(CHECKPOINTSYSIN,w,0,0)
	ExtrnRtn(DISABLEACTIONFINISH,w,0,1,b)
	ExtrnRtn(QUERYKBDLEDS,w,0,1,x)
	ExtrnRtn(QUERYKBDSTATE,w,0,1,x)
	ExtrnRtn(READACTIONCODE,w,0,1,x)
	ExtrnRtn(READKBD,w,0,1,x)
	ExtrnRtn(READKBDDIRECT,w,0,2,w,x)
	ExtrnRtn(SETKBDLED,w,0,2,w,b)
	ExtrnRtn(SETKBDUNENCODEDMODE,w,0,1,b)
	ExtrnRtn(SETSYSINMODE,w,0,2,w,w)
) fi
if (bBTOScm eq 1) then (
$Title( BTOS Timer Management)  Eject
	ExtrnRtn(CLOSERTCLOCK,w,0,1,x)
	ExtrnRtn(COMPACTDATETIME,w,0,2,x,z)
	ExtrnRtn(DELAY,w,0,1,w)
	ExtrnRtn(EXPANDDATETIME,w,0,2,q,x)
	ExtrnRtn(GETDATETIME,w,0,1,x)
	ExtrnRtn(OPENRTCLOCK,w,0,1,x)
	ExtrnRtn(RESETTIMERINT,w,0,1,x)
	ExtrnRtn(SETDATETIME,w,0,2,w,w)
	ExtrnRtn(SETTIMERINT,w,0,1,x)
) fi
if (bBTOSem eq 1) then (
$Title( BTOS Exchange Management)  Eject
	ExtrnRtn(ALLOCEXCH,w,0,1,y)
	ExtrnRtn(DEALLOCEXCH,w,0,1,w)
	ExtrnRtn(QUERYDEFAULTRESPEXCH,w,0,1,y)
) fi
if (bBTOSpm eq 1) then (
$Title( BTOS Parameter Management)  Eject
	ExtrnRtn(CPARAMS,w,0,0)
	ExtrnRtn(CSUBPARAMS,w,0,1,w)
	ExtrnRtn(GETPASCB,w,0,1,z)
	ExtrnRtn(RGPARAM,w,0,3,w,w,x)
	ExtrnRtn(RGPARAMINIT,w,0,3,q,w,w)
	ExtrnRtn(RGPARAMSETELTNEXT,w,0,1,x)
	ExtrnRtn(RGPARAMSETLISTSTART,w,0,1,w)
	ExtrnRtn(RGPARAMSETSIMPLE,w,0,2,w,x)
) fi
if (bBTOSqm eq 1) then (
$Title( BTOS Queue Management)  Eject
	ExtrnRtn(ADDQUEUEENTRY,w,0,9,x,w,b,b,w,x,w,z,w)
	ExtrnRtn(ESTABLISHQUEUESERVER,w,0,4,x,w,w,b)
	ExtrnRtn(MARKKEYEDQUEUEENTRY,w,0,12,x,w,x,w,w,x,w,w,x,w,x,w)
	ExtrnRtn(MARKNEXTQUEUEENTRY,w,0,7,x,w,b,x,w,x,w)
	ExtrnRtn(READKEYEDQUEUEENTRY,w,0,12,x,w,x,w,w,x,w,w,x,w,x,w)
	ExtrnRtn(READNEXTQUEUEENTRY,w,0,7,x,w,q,x,w,x,w)
	ExtrnRtn(REMOVEKEYEDQUEUEENTRY,w,0,8,x,w,x,w,w,x,w,w)
	ExtrnRtn(REMOVEMARKEDQUEUEENTRY,w,0,3,x,w,q)
	ExtrnRtn(REWRITEMARKEDQUEUEENTRY,w,0,5,x,w,q,x,w)
	ExtrnRtn(TERMINATEQUEUESERVER,w,0,2,x,w)
	ExtrnRtn(UNMARKQUEUEENTRY,w,0,3,x,w,q)
) fi
if (bBTOSsm eq 1) then (
$Title( BTOS Printer Spooler Management)  Eject
	ExtrnRtn(CONFIGURESPOOLER,w,0,9,b,x,w,x,w,x,w,b,b)
	ExtrnRtn(SPOOLERPASSWORD,w,0,4,x,w,x,w)
) fi
if (bBTOSgm eq 1) then (
$Title( BTOS Contingency Management)  Eject
	ExtrnRtn(CRASH,x,0,1,w)
	ExtrnRtn(FATALERROR,x,0,1,w)
	ExtrnRtn(WRITELOG,w,0,2,x,w)
) fi
if (bBTOStm eq 1) then (
$Title( BTOS Task Management)  Eject
	ExtrnRtn(CHAIN,w,0,7,x,w,x,w,w,w,b)
	ExtrnRtn(ERROREXIT,x,0,1,w)
	ExtrnRtn(EXIT,x,0,0)
	ExtrnRtn(LOADTASK,w,0,3,w,w,b)
) fi
;*****************************************************************************
;*	End of system routine definitions				     *
;*****************************************************************************

DSEG	segment	byte	public	'RTSDATA'

VID_SUPPRESS	db	bFS	; 0 = full screen, including exec lines.
				; 1 = short screen, do not reset exec lines.

;*****************************************************************************
;*	The following variable may be altered by editing this module.	     *
;*****************************************************************************
EXT_BYTES	dd	04000h	; Bytes : default size of ShortLived memory
				; left available outside the Cobol RTS.
DSEG	ENDS

if(pass2 eq 1) then (
out(

To use the new nonCOBOL procedures please relink the COBOL2 run time system.
This can be done using the submit file Bind.sub )

) fi

	END

ORYLL,w,0,2,w,z)
	ExtrnRtn(ALLOCMEMORYSL,w,0,2,w,z)
	Extr