Trailing-Edge
-
PDP-10 Archives
-
KS10_APT_INSTALL_TAPE
-
uetp/lib/unv4.for
There is 1 other file named unv4.for in the archive. Click here to see a list.
* 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