Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

*	INVOKE SUBS1 OF ORDTIN PRIVACY KEY COMPILE ORDER1.
	INCLUDE 'SUBS1.SUB'
	CALL SBIND('ORDTIN',00001,'SUBS1',00035,SYSCOM)
	CALL BIND(00006,UNDEFP(1),CUSKEY,CUSDBK,UNDEFP(7),0)
	CALL BIND(00011,ORDNUM,UNDEFP(25),UNDEFP(27),UNDEFP(28))
	CALL BIND(00016,UNDEFP(30),UNDEFP(32),UNDEFP(34),UNDEFP(35))
	CALL BIND(00021,UNDEFP(37),PRDESC,UNDEFP(39),UNDEFP(41),UNDEFP(42
	1),UNDEFP(44),UNDEFP(45),PINS)
	CALL BIND(00030,OSORD,UNDEFP(46),0)
	CALL BIND(00033,UNDEFP(48),SLSOFF,UNDEFP(54),0)
	CALL BIND(00037,UNDEFP(57),UNDEFP(59),UNDEFP(64),UNDEFP(71),UNDEF
	1P(73))
	CALL BIND(00043,UNDEFP(75),UNDEFP(77))
	CALL BIND(00001)
	CALL EBIND(0,DBNULL)
	IF (ERCNT.NE.0) ACCEPT 101,J
*	OPEN AREA AREA1 USAGE-MODE IS EXCLUSIVE UPDATE.
	CALL OPEND( -21 , -25 ,0,00002)
	IF (ERCNT.NE.0) ACCEPT 101,J
	SLSOFF(1,1)='HOME'


*	FIND FIRST RECORD OF AREA1 AREA.
	CALL FIND3( -12 ,0,00002, -18 )
	IF (ERCNT.NE.0) ACCEPT 101,J

	DO 12 I=1,25
*	FIND NEXT SLSENG RECORD OF AREA1 AREA.
	CALL FIND3( -15 ,00033,00002, -18 )
	IF (ERCNT.NE.0) ACCEPT 101,J
*	FIND NEXT RECORD OF SLSCUS-SET SET.
	CALL FIND3( -15 ,0,00049, -20 )
	IF (ERCNT.NE.0) ACCEPT 101,J
*	REMOVE CUSTOM FROM SLSCUS-SET.
	CALL REMOV(00006,00049)
	IF (ERCNT .NE. 0) ACCEPT 101,J
*	DELETE CUSTOM.
	CALL DELETR(00006,0)
*	FIND NEXT RECORD OF SLSCUS-SET SET.
	CALL FIND3( -15 ,0,00049, -20 )
	IF (ERCNT.NE.0) ACCEPT 101,J
*	REMOVE CUSTOM FROM SLSCUS-SET.
	CALL REMOV(00006,00049)
	IF (ERCNT .NE. 0) ACCEPT 101,J
*	FIND NEXT RECORD OF SLSCUS-SET SET.
	CALL FIND3( -15 ,0,00049, -20 )
	IF (ERSTAT.NE.0307) ACCEPT 101,J
12	CONTINUE

*	FIND FIRST RECORD OF AREA1 AREA.
	CALL FIND3( -12 ,0,00002, -18 )
*	DELETE ALL.
	CALL DELETR(0, -17 )
	DO 13 I=1,1000
*	FIND NEXT RECORD OF AREA1 AREA.
	CALL FIND3( -15 ,0,00002, -18 )
	IF (ERSTAT.EQ.0307) GOTO 20
	IF (ERSTAT.NE.0) ACCEPT 101,J
*	DELETE ALL.
	CALL DELETR(0, -17 )
	IF (ERCNT.NE.0) ACCEPT 101,J
13	CONTINUE

*20	CLOSE ALL.
20	CALL CLOSED( -17 )

101	FORMAT(I)
102	FORMAT (1X ,I8,2X,O12)
	END