Google
 

Trailing-Edge - PDP-10 Archives - BB-4148E-BM - sources/thefoi.fml
There are 2 other files named thefoi.fml in the archive. Click here to see a list.
	PROGRAM INIT
	IMPLICIT INTEGER (A-Z)
	LOGICAL INVKEY, ENDSET, SIMDEL, OK, EXMS, DONE
	COMMON /ERBLK/ INVKEY, ENDSET, SIMDEL, OK, DONE
	COMMON /EX/ EXMS
	COMMON /UTIL/ FUNCTN


C	*******************************************************************
C	*                                                                 *
C	*        copyright (c) 1980 DIGITAL Equipment Corporation         *
C	*                                                                 *
C	*  This program is for instructional purposes only; in order to   *
C	*  illustrate certain aspects of this software, this program may  *
C	*  contain constructs and practices that would not be suitable    *
C	*  for use in a production environment.  DIGITAL Equipment Cor-   *
C	*  poration assumes no responsibility for any errors which may    *
C	*  exist in this program.                                         *
C	*                                                                 *
C	*  This program was written by software documentation staff in    *
C	*  order to best explain concepts involved in using the DBMS DML. *
C	*  As such, the primary consideration was writing code that is,   *
C	*  for the most part, as simple as possible.  Consequently, the   *
C	*  approach taken was to write in-line code because, for the most *
C	*  part, it can be easier to understand, albeit harder to main-   *
C	*  tain.                                                          *
C	*                                                                 *
C	*  A second major factor in the writing of this program was that  *
C	*  only one program could be written.  This constraint was added  *
C	*  because the theme example programs are included on the dis-    *
C	*  tribution tape and we could only include one program there.    *
C	*  Consequently, the procedure shown here where everything is in- *
C	*  cluded in one program is not one that should be followed by    *
C	*  users performing similiar kinds of functions.                  *
C	*                                                                 *
C	*  Also, this program was written solely to demonstrate a dis-    *
C	*  series of functions.  While all these functions work, they     *
C	*  were not given the kind of load and performance testing that   *
C	*  should be, or are, given to true application software.         *
C	*                                                                 *
C	*******************************************************************
*DBMS
	INVOKE SUB-SCHEMA Fortran-System-Programmer-SS OF SCHEMA Theme
		PRIVACY KEY FOR COMPILE IS ACEDB.
*DBMS
	USE ERRTN IF ERSTAT.
	EXMS = .TRUE.

*DBMS
	OPEN AREA Head-Area
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 1
		TYPE 2
2		FORMAT (' Not able to open Head-Area.')
		GO TO 999
1	CONTINUE
*DBMS
	OPEN AREA Index-Block-Area
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 3
		TYPE 4
4		FORMAT (' Not able to open Index-Block-area.')
		GO TO 999
3	CONTINUE
*DBMS
	OPEN AREA Inventory-Area
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 5
		TYPE 6
6		FORMAT (' Not able to open Inventory-Area.')
		GO TO 999
5	CONTINUE
*DBMS
	OPEN AREA Manufacturing-Area
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 7
		TYPE 8
8		FORMAT (' Not able to open Manufacturing-Area.')
		GO TO 999
7	CONTINUE
*DBMS
	OPEN AREA Orders-Area
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 9
		TYPE 88
88		FORMAT (' Not able to open Orders-Area.')
		GO TO 999
9	CONTINUE
*DBMS
	OPEN AREA Personnel-Area
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 10
		TYPE 11
11		FORMAT (' Not able to open Personnel-Area.')
		GO TO 999
10	CONTINUE
*DBMS
	OPEN AREA Personal-Area
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 21
		TYPE 22
22		FORMAT (' Not able to open Personal-Area')
		GO TO 999
21	CONTINUE
*DBMS
	OPEN AREA TEMPORARY-AREA
		USAGE-MODE IS EXCLUSIVE UPDATE
		PRIVACY KEY IS N1234.
	IF (ERSTAT .EQ. 0) GO TO 24
		TYPE 23
23		FORMAT ('NOT ABLE TO OPEN TEMPORARY-AREA')
		GO TO 999
C*  Initialize.                                                                *


24	CONTINUE
	OHDUM = -1
	OHNUM = 0
*DBMS
	STORE Number-of-Last-Order-Rec.
	IF (ERSTAT .EQ. 0) GO TO 200
		TYPE 100
100		FORMAT (' Number of last order record not stored')
		GO TO 999
200	TYPE 210
210	FORMAT (' NUMBER-OF-LAST-ORDER-REC STORED')
	CHDUM = -1
	CHNUM = 0
*DBMS
	STORE Cust-Head-Rec.
	IF (ERSTAT .EQ. 0) GO TO 400
		TYPE 300
300		FORMAT (' Cust-Head not stored.')
		GO TO 999
400	TYPE 500
500	FORMAT (' Cust-head stored.')
	EHDUM = -1
	EHNUM = 0
*DBMS
	STORE Employee-Head-Rec.
	IF (ERSTAT .EQ. 0) GO TO 700
		TYPE 600
600		FORMAT (' Employee-Head not stored.')
		GO TO 999
700	TYPE 800
800	FORMAT (' Employee-Head stored.')
	PRDUM = -1
	PRNUM = 0
*DBMS
	STORE Part-Head-Rec.
	IF (ERSTAT .EQ. 0) GO TO 1000
		TYPE 900
900		FORMAT (' Part-Head not stored')
		GO TO 999
1000	TYPE 1100
1100	FORMAT (' Part-Head stored.')
	PHDUM = -1
	PHNUM = 0
*DBMS
	STORE Purchase-Order-Head-Rec.
	IF (ERSTAT .EQ. 0) GO TO 1300
		TYPE 1200
1200		FORMAT (' Purchase-Order-Head not stored.')
		GO TO 999
1300	TYPE 1310
1310	FORMAT (' PURCHASE-ORDER-HEAD-REC STORED')
	WHDUM = -1
	WHNUM = 0
*DBMS
	STORE Work-Order-Head-Rec.
	IF (ERSTAT .EQ. 0) GO TO 1500
		TYPE 1400
1400		FORMAT (' Work-Order-Head not stored')
		GO TO 999
1500	TYPE 1600
1600	FORMAT (' Work-Order-Head stored.')

999	CONTINUE
*DBMS
	CLOSE RUN-UNIT.
*DBMS
	CLOSE JOURNAL.
*DBMS
	END INIT.
	SUBROUTINE ERRTN

C*******************************************************************************
C*                                                                             *
C*          E R R T N                                                          *
C*                                                                             *
C* FORTRAN USE procedure.                                                      *
C*                                                                             *
C*******************************************************************************

	IMPLICIT INTEGER (A-Z)
	LOGICAL INVKEY, ENDSET, SIMDEL, OK, EXMS, DONE, FINAL
	COMMON /EX/ EXMS
	COMMON /ERBLK/ INVKEY, ENDSET, SIMDEL, OK, DONE
	INTEGER VMSGS (51)

*DBMS
	ACCESS SUB-SCHEMA Fortran-System-Programmer-SS OF SCHEMA Theme
		PRIVACY KEY FOR COMPILE IS ACEDB.

	DATA (VMSGS(I),I=1,51)/'Host ','Verbs','     ',
	1 'Close',' Erro','r    ', 'Delet','e Err','or   ',
	3 'Find ','Error','     ', '     ','     ','     ',
	5 'Get E','rror ','     ', '     ','     ','     ',
	7 'Inser','t Err','or   ', 'Modif','y Err','or   ',
	9 'Open ','Error','     ', '     ','     ','     ',
	1 'Remov','e Err','or   ', 'Store',' Erro','r    ',
	3 '     ','     ','     ', '     ','     ','     ',
	5 'Bind ','Error','     ', 'Call ','Error','     '/

	INVKEY = .FALSE.
	ENDSET = .FALSE.
	SIMDEL = .FALSE.
	OK = .FALSE.
	IF (ERSTAT .NE. 240) GO TO 101
		SIMDEL = .TRUE.
		GO TO 999
101	IF (ERSTAT .NE. 307) GO TO 102
		ENDSET = .TRUE.
		GO TO 999
102	IF (ERSTAT .NE. 326) GO TO 103
		INVKEY = .TRUE.
		GO TO 999
103	IF (.NOT. EXMS) GO TO 998
	VERB = ERSTAT / 100
	MSG = ERSTAT - VERB*100
	TYPE 104,(VMSGS((VERB-1)*3-1+I),I=1,3)
104	FORMAT (1X,3A5)
	IF (VERB .EQ. 0 .OR. VERB .EQ. 1 .OR. VERB .EQ. 9) DONE = .TRUE.
	IF (VERB .EQ. 15 .OR. VERB .EQ. 16) DONE = .TRUE.
	IF (MSG .NE. 0) GO TO 801
		TYPE 105
		GO TO 998
801	IF (MSG .NE. 1) GO TO 802
		TYPE 1
		GO TO 998
802	IF (MSG .NE. 2) GO TO 803
		TYPE 2
		GO TO 998
803	IF (MSG .NE. 3) GO TO 804
		TYPE 3
		GO TO 998
804	IF (MSG .NE. 4) GO TO 805
		TYPE 4
		GO TO 998
805	IF (MSG .NE. 5) GO TO 806
		TYPE 5
		GO TO 998
806	IF (MSG .NE. 6) GO TO 807
		TYPE 6
		GO TO 998
807	IF (MSG .NE. 7) GO TO 808
		TYPE 7
		GO TO 998
808	IF (MSG .NE. 8) GO TO 809
		TYPE 8
		GO TO 998
809	IF (MSG .NE. 9) GO TO 810
		TYPE 9
		GO TO 998
810	IF (MSG .NE. 10) GO TO 811
		TYPE 10
		GO TO 998
811	IF (MSG .NE. 11) GO TO 812
		TYPE 11
		GO TO 998
812	IF (MSG .NE. 12) GO TO 813
		TYPE 12
		GO TO 998
813	IF (MSG .NE. 13) GO TO 814
		TYPE 13
		GO TO 998
814	IF (MSG .NE. 14) GO TO 815
		TYPE 14
		GO TO 998
815	IF (MSG .NE. 15) GO TO 816
		TYPE 15
		GO TO 998
816	IF (MSG .NE. 16) GO TO 817
		TYPE 16
		GO TO 998
817	IF (MSG .NE. 17) GO TO 818
		TYPE 17
		GO TO 998
818	IF (MSG .NE. 18) GO TO 819
		TYPE 18
		GO TO 998
819	IF (MSG .NE. 19) GO TO 820
C		NO ERROR 19
		GO TO 998
820	IF (MSG .NE. 20) GO TO 821
		TYPE 20
		GO TO 998
821	IF (MSG .NE. 21) GO TO 822
C		NO ERROR 21
		GO TO 998
822	IF (MSG .NE. 22) GO TO 823
		TYPE 22
		GO TO 998
823	IF (MSG .NE. 23) GO TO 824
		TYPE 23
		GO TO 998
824	IF (MSG .NE. 24) GO TO 825
		TYPE 24
		GO TO 998
825	IF (MSG .NE. 25) GO TO 826
		TYPE 25
		GO TO 998
826	IF (MSG .NE. 26) GO TO 827
		TYPE 26
		GO TO 998
827	IF (MSG .NE. 27) GO TO 828
C		NO ERROR 27
		GO TO 998
828	IF (MSG .NE. 28) GO TO 829
		TYPE 28
		GO TO 998
829	IF (MSG .NE. 29) GO TO 830
C		NO ERROR 29
		GO TO 998
830	IF (MSG .NE. 30) GO TO 831
		TYPE 30
		GO TO 998
831	IF (MSG .NE. 31) GO TO 832
		TYPE 31
		GO TO 998
832	IF (MSG .NE. 32) GO TO 833
		TYPE 32
		GO TO 998
833	IF (MSG .NE. 33) GO TO 834
		TYPE 33
		GO TO 998
834	IF (MSG .NE. 34) GO TO 835
		TYPE 34
		GO TO 998
835	IF (MSG .NE. 35) GO TO 836
		TYPE 35
		GO TO 998
836	IF (MSG .NE. 36) GO TO 837
		TYPE 36
		GO TO 998
837	IF (MSG .NE. 37) GO TO 838
		TYPE 37
		GO TO 998
838	IF (MSG .NE. 38) GO TO 839
		TYPE 38
		GO TO 998
839	IF (MSG .NE. 39) GO TO 840
		TYPE 39
		GO TO 998
840	IF (MSG .NE. 40) GO TO 841
		TYPE 40
		GO TO 998
841	IF (MSG .NE. 41) GO TO 842
		TYPE 41
		GO TO 998
842	IF (MSG .NE. 42) GO TO 843
		TYPE 42
		GO TO 998
843	IF (MSG .NE. 43) GO TO 844
		TYPE 43
		GO TO 998
844	IF (MSG .NE. 44) GO TO 845
		TYPE 44
		GO TO 998
845	IF (MSG .NE. 45) GO TO 846
		TYPE 45
		GO TO 998
846	IF (MSG .NE. 46) GO TO 847
C		NO ERROR 46
		GO TO 998
847	IF (MSG .NE. 47) GO TO 848
C		NO ERROR 47
		GO TO 998
848	IF (MSG .NE. 48) GO TO 849
C		NO ERROR 48
		GO TO 998
849	IF (MSG .NE. 49) GO TO 850
C		NO ERROR 49
		GO TO 998
850	IF (MSG .NE. 50) GO TO 851
C		NO ERROR 50
		GO TO 998
851	IF (MSG .NE. 51) GO TO 852
C		NO ERROR 51
		GO TO 998
852	IF (MSG .NE. 52) GO TO 853
C		NO ERROR 52
		GO TO 998
853	IF (MSG .NE. 53) GO TO 854
C		NO ERROR 53
		GO TO 998
854	IF (MSG .NE. 54) GO TO 855
C		NO ERROR 54
		GO TO 998
855	IF (MSG .NE. 55) GO TO 856
		TYPE 55
		GO TO 998
856	IF (MSG .NE. 56) GO TO 857
		TYPE 56
		GO TO 998
857	IF (MSG .NE. 57) GO TO 858
		TYPE 57
		GO TO 998
858	IF (MSG .NE. 58) GO TO 859
		TYPE 58
		GO TO 998
859	IF (MSG .NE. 59) GO TO 860
		TYPE 59
		GO TO 998
860	IF (MSG .NE. 60) GO TO 861
		TYPE 60
		GO TO 998
861	IF (MSG .NE. 61) GO TO 862
		TYPE 61
		GO TO 998
862	IF (MSG .NE. 62) GO TO 863
		TYPE 62
		GO TO 998
863	IF (MSG .NE. 63) GO TO 864
		TYPE 63
		GO TO 998
864	IF (MSG .NE. 64) GO TO 865
		TYPE 64
		GO TO 998
865	IF (MSG .NE. 65) GO TO 866
		TYPE 65
		GO TO 998
866	IF (MSG .NE. 66) GO TO 867
		TYPE 66
		GO TO 998
867	IF (MSG .NE. 67) GO TO 868
		TYPE 67
		GO TO 998
868	IF (MSG .NE. 68) GO TO 869
C		NO ERROR 68
		GO TO 998
869	IF (MSG .NE. 69) GO TO 998
C		NO ERROR 69

998	FATAL = .TRUE.
	TYPE 1000, ERSTAT, ERSET, ERREC, ERAREA, ERCNT
1000	FORMAT (/,' ERROR STATUS = ', I5, /,
	1 ' ERROR SET = ', 6A5,/,
	2 ' ERROR RECORD = ', 6A5,/,
	3 ' ERROR AREA = ', 6A5,/,
	4 ' ERROR COUNT = ', I10)
C ERROR MESSAGES

105	FORMAT (' A warning.  Compile-time and run-time versions of',/,
	1       ' schema differ.')
1	FORMAT (' Area not open.')
2	FORMAT (' Data base key inconsistent with area-name.  Can also',/,
	1       ' indicate that a referenced page number is in an area',/,
	2       ' that is not in the invoked sub-schema.')
3	FORMAT (' Record affected (deleted or removed) by concurrent',/,
	1       ' application.')
4	FORMAT (' Data name invalid or inconsistent.  This can occur',/,
	1       ' during GET or MODIFY with a data-name list.')
5	FORMAT (' Violation of DUPLICATES NOT ALLOWED clause.')
6	FORMAT (' Current of set, area, or record-name not known.')
7	FORMAT (' End of set, area, or record.')
8	FORMAT (' Referenced area, record, or set-name not in sub-',/,
	1 ' schema.  This may occur because:',/,
	2 ' 1.  DBCS encounters a record type not in the sub-',/,
	3 '     schema when traversing a set.',/,
	4 ' 2.  Set type owned by the object record type is not',/,
	5 '     in the sub-schema.',/,
	6 ' 3.  The VIA set is not in the sub-schema -- during set',/,
	7 '     selection occurrence.',/,
	8 ' 4.  All subkeys are not in the sub-schema during CALC',/,
	9 '     processing or searching a sorted set.',/,
	1 ' 5.  The sort key or a set not in the sub-schema is',/,
	2 '     modified.')
9	FORMAT (' Update usage mode required.  This is an attempt to',/,
	1       ' use an updating verb when the specified area is open',/,
	2       ' for retrieval.')
10	FORMAT (' Privacy breach attempted.')
11	FORMAT (' Physical space not available.  No room remains for',/,
	1       ' storing records.  This can occur while DBCS is trying',/,
	2       ' to store an internal record type such as an index',/,
	3       ' or buoy.')
12	FORMAT (' Line numbers for data base keys are exhausted.')
13	FORMAT (' No current record of run-unit.')
14	FORMAT (' Object record is MANDATORY AUTOMATIC member of',/,
	1       ' named set.')
15	FORMAT (' Oject record is MANDATORY type or not member type',/,
	1       ' at all in named set.  This is an attempt to REMOVE',/,
	2       ' a record which is either a MANDATORY member or not',/,
	3       ' a member of named set.')
16	FORMAT (' Record is already a member of named set.')
17	FORMAT (' Record has been deleted.  This can occur during a',/,
	1       ' FIND CURRENT of RECORD, SET, AREA, or RUN-UNIT',/,
	2       ' or during a FIND NEXT of SET or AREA.')
18	FORMAT (' Data conversion unsuccessful.')
C NO ERROR 19
20	FORMAT (' Current record of run-unit not of correct record-',/,
	1       ' type.')
C NO ERROR 21
22	FORMAT (' Record not currently member of named or implied set.')
23	FORMAT (' Illegal area-name passed in area identification.')
24	FORMAT (' Temporary and permanent areas referenced in same',/,
	1       ' DML verb.')
25	FORMAT (' No set occurrence satisfies argument values.  This',/,
	1       ' can mean, for example, that the CALC value in the',/,
	2       ' UWA matched no owner record.')
26	FORMAT (' No record satisfies RSE specified.  This is a',/,
	1       ' catch-all exception for the FIND verb.')
C NO ERROR 27
28	FORMAT (' Area already open.')
C NO ERROR 29
30	FORMAT (' Unqualified DELETE attempted on non-empty set.')
31	FORMAT (' Unable to open the Schema File.')
32	FORMAT (' Insufficient space allocated for the data-name.',/,
	1       ' The SIZE clause specifies less space than the',/,
	2       ' compiler needs.')
33	FORMAT (' None of the areas a record type can be within',/,
	1       ' are in the sub-schema.')
34	FORMAT (' A set is in the sub-schema, but its owner record',/,
	1       ' type is not.')
35	FORMAT (' Dynamic use-vector is full (FORTRAN ONLY).')
36	FORMAT (' Attempt to invoke too many sub-schemas (more than',/,
	1       ' 8); or attempt to use UNSET with empty sub-schema',/,
	2       ' stack, or SETDB with a full sub-schema stack.')
37	FORMAT (' Sub-schema passed to SETDB is not already invoked.')
38	FORMAT (' Duplicate operation attempted on a resource.  This',/,
	1       ' can occur because: 1) you attempt to open the',/,
	2       ' journal file twice (you have opened it in EXCLUSIVE',/,
	3       ' UPDATE usage-mode and are now opening a data area',/,
	4       ' in UPDATE usage-mode), or 2) you call JSTRAN while',/,
	5       ' a transaction is already active, or 3) you have',/,
	6       ' multiple INVOKE statements and attempt to open',/,
	7       ' the same area twice.')
39	FORMAT (' data base file not found.')
40	FORMAT (' Request access conflicts with existing access; that',/,
	1       ' is, resource is not available.  This can result from',/,
	2       ' an attempt to:',/,
	3       ' 1.  Open an area in a USAGE-MODE incompatible with',/,
	4       '     that of another run-unit using the same area.',/,
	5       ' 2.  Open the journal in a way that results in a',/,
	6       '     USAGE-MODE conflict.',/,
	7       ' 3.  DELETE a record retained by another run-unit.',/,
	8       ' 4.  Attempt to open area or the journal and the',/,
	9       '     file system signals a file-protection error.')
41	FORMAT (' No JFNs available.  An attempt to open too many areas.')
42	FORMAT (' Area in undefined state.  Use DBMEND to force open',/,
	1       ' the area and return it to a valid state.')
43	FORMAT (' Area in creation state.  This can happen to the',/,
	1       ' system area only.  This will occur if run-unit',/,
	2       ' execution aborts at just the right time during',/,
	3       ' the first OPEN of the system area.  Should this occur',/,
	4       ' either rerun SCHEMA or create a 0-length file with',/,
	5       ' a text editor.')
44	FORMAT (' Attempt to call a journal-processing entry point',/,
	1       ' before the journalling system has been initialized',/,
	2       ' (by the first OPEN that requires journalling).')
45	FORMAT (' Attempt to backup the database with JBTRAN 1)',/,
	1       ' while DBCS''s Cannot-Backup-Updates bit is set, or',/,
	2       ' 2) when the journal is shared and commands are the',/,
	3       ' interleaving unit, or 3) when the journal is shared,',/,
	4       ' transactions are the interleaving unit, and the',/,
	5       ' argument given to JBTRAN is greater than 0.')
C NO ERROR 46
C NO ERROR 47
C NO ERROR 48
C NO ERROR 49
C NO ERROR 50
C NO ERROR 51
C NO ERROR 52
C NO ERROR 53
C NO ERROR 54
55	FORMAT (' Pseudo-exception.  DBCS types message that no',/,
	1       ' sub-schema yet initialized.')
56	FORMAT (' Inconsistent data in the data base file.  DBMEND',/,
	1       ' should be used to restore the data base to a valid',/,
	2       ' state.  If the problem can be reproduced, it',/,
	3       ' probably indicates a DBCS software error.')
57	FORMAT (' Probably a DBCS software error.  If this recurs,',/,
	1       ' report it.')
58	FORMAT (' Illegal argument passed by programmer or setup',/,
	1       ' host interface; for example, passing a set-name',/,
	2       ' with the STORE command.')
59	FORMAT (' No more memory available.')
60	FORMAT (' Unable to access a database file.  The operating',/,
	1       ' system reported an I/O error, either in normal',/,
	2       ' operations or in trying to open a journal for',/,
	3       ' appending.')
61	FORMAT (' Unable to append to journal (that is, the journal',/,
	1       ' is in an aborted state but has not been designated',/,
	2       ' as being done with).')
62	FORMAT (' Attempt to enter DBCS at other than JBTRAN, SBIND,',/,
	1       ' SETDB, or UNSET while the system-in-undefined-state',/,
	2       ' bit is on.')
63	FORMAT (' Unable to complete restoration of the proper data',/,
	1       ' base state.  This occurs either during JBTRAN',/,
	2       ' initialization of a run-unit at the start of a ',/,
	3       ' command or transaction.')
64	FORMAT (' Exceptions while processing exception.')
65	FORMAT (' Monitor space for ENQUEUE entries exhausted, or',/,
	1       ' ENQUEUE quota exceeded.')
66	FORMAT (' ENQUEUE/DEQUEUE failure (for example, you do not',/,
	1       ' have ENQUEUE capabilities, or an unacceptable',/,
	2       ' argument block has been created by DBCS).')
67	FORMAT (' Unable to initialize magnetic tape service because,',/,
	1       ' for example, the IPCF block is bad; the IPCF',/,
	2       ' message is too long; or DAEMDB is not running.')
C NO ERROR 68
C NO ERROR 69

999	RETURN
*DBMS
	END ERRTN.