FTN4
      PROGRAM TMPG5(5),92080-16457 REV.2026  800418 
C 
C 
C     NAME:   TMPG5,ILPRS 
C     SOURCE: &TMG5A    92080-18457 
C     BINARY: %TMG5A    92080-16457 
C 
C     PGMR: DANIEL POT/FRANCOIS GAULLIER    HPG 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C     **************************************************************
C     *                                                            *
C     *   THIS PROGRAM HANDLES SCREENS # X & Y USING AN INTERC-    *
C     *   TIVE DIALOGUE ON A 2645/2648 TERMINAL.                   *
C     *   DEFINTION OF INTERACTIVE LU (HP 307X TERMINALS)          *
C     *                AND T.U.S. (USER WRITTEN SUBROUTINE)        *
C     *                                                            *
C     **************************************************************
C 
C     STOP USED:  5000 - 5002 - 5003
C     ----------
C 
C     IJOB = 2   SCREEN HAS BEEN PRINT, READ AND ANALYSE
C     IJOB = 3   DO ALL T.U.S. DEFINITION INTO USER PARTITION 
C     IJOB = 0   DO EVERYTHING (LU INT. & AUX. AND T.U.S.) DEFINITION 
C 
C     IEND = 0 : CURRENT INTERACTIVE PROCESS SHOULD BE CONTINUED
C     IEND = 1 : END OF INTERACTIVE PROCESS 
C     IEND = 2 : ABORT TMPGN PROGRAM
C     IEND = 3 : PREVIOUS FAMILY SCREEN 
C 
C 
C-----LABEL COMMON # 1  GENERAL INFORMATION 
C 
CCB1
C*********************************************************************
C 
C-----LABELED COMMON # 1  GENERAL INFORMATION 
C 
      COMMON /TMGC1/LU,LUPRT,LUOUT,ISYTP,IPARAM(5)
C 
C     LU     - USER TERMIAL LU
C     LUPRT  - LISTING LU 
C     LUOUT  - NOT USED 
C     ISYTP  - SYSTEM TYPE (MUST BE .EQ. -9, RTE-IV)
C     IPARAM - TMPGN OPERATING PARAMETERS:
C              ISCRN  - CURRENT SCREEN NO.
                        EQUIVALENCE (ISCRN,IPARAM(1)) 
C              IOFST  - OFFSET INTO BUFFER NCRTH
                        EQUIVALENCE (IOFST,IPARAM(2)) 
C              IEND   - INTERACTIVE OPERATION INDICATOR 
C                       0 - CURRENT PROCESS 
C                       1 - END OF PROCESS
C                       2 - ABORT TMPGN 
C                       3 - PREVIOUS SCREEN 
                        EQUIVALENCE (IEND,IPARAM(3))
C              IJOB   - TMS FUNCTION INDICATOR
C                       0 - DEFINE (INT. AND AUX. LU'S, AND T.U.S.) 
C                       1 - SCREEN HAS BEEN PRINTED, PERFORM ANALYSIS 
C                       3 - DEFINE T.U.S. INTO USER PARTITION 
                        EQUIVALENCE (IJOB,IPARAM(4))
C 
C*********************************************************************
CCB1
C 
C-----LABEL COMMON # 2  FLAGS 
C 
CCB2
C*********************************************************************
C 
C-----LABELED COMMON # 2  FLAGS 
C 
      COMMON /TMGC2/ITMFL,IRQFLG(30),IMOTR(9),IVASC0(9) 
C 
C     ITMFL  -
C     IRQFLG - LOAD FLAGS 
C     IMOTR  - BUFFER FOR TMS INFORMATION:
C              IMOFNC - TMS OPERATION CODE
C                       1 - CREATE/MODIFY 
C                       2 - MODIFY LU # 
C                       3 - MODIFY MAIN PROG
C                       4 - RELOAD TMS-SUBROUTINES
C                       5 - LOAD AN APPLICATION 
C                       6 - LIST
C                       7 - PURGE APPLICATION 
C                       8 - END TMPGN 
                        EQUIVALENCE (IMOFNC,IMOTR(1)) 
C              IMOLOA - LOAD OPTION (SCREEN 0)
C                       1 - NO LOAD 
C                       2 - BACKGROUND TEMPORARILY
C                       3 - BACKGROUND REPLACEMENT
C                       4 - BACKGROUND ADDITION 
C                       5 - REAL TIME TEMPORARILY 
C                       6 - REAL TIME REPLACEMENT 
C                       7 - REAL TIME ADDITION
                        EQUIVALENCE (IMOTR(2),IMOLOA) 
C              IMOMAP - LOADER MAP OPTION 
                        EQUIVALENCE (IMOTR(3),IMOMAP) 
C              IMOFLG - SEARCH %TMSLB FLAG
                        EQUIVALENCE (IMOTR(4),IMOFLG) 
C              IMONAM - APPLICATION NAME
                        DIMENSION IMONAM(2) 
                        EQUIVALENCE (IMOTR(6),IMONAM(1))
C              IMOSEC - SECURITY CODE 
                        EQUIVALENCE (IMOTR(8),IMOSEC) 
C              IMOCRN - CARTRIDGE NUMBER
                        EQUIVALENCE (IMOTR(9),IMOCRN) 
C     IVASC0 - DISPLAY BUFFER FOR SCREEN INFORMATION
C 
C*********************************************************************
CCB2
C 
C-----LABEL COMMON # 3  BUFFER AREA 
C 
CCB3
C*********************************************************************
C 
C-----LABELED COMMON # 3  BUFFER AREA 
C 
      COMMON /TMGC3/IREFC,ILUGH,INTMS,ILPRG,IDECL,ILGMX,NBPRO 
     .             ,NCRTH(2540) 
C 
C     IREFC  -
C     ILUGH  -
C     INTMS  -
C     ILPRG  -
C     IDECL  -
C     ILGMX  -
C     NBPRO  -
C     NCRTH  - OUTPUT FILE BUFFER:
C              NCNOWD - NO. OF WORDS IN FILE
                        EQUIVALENCE (NCNOWD,NCRTH(1)) 
C              NCINLU - BUFFER ADDR OF INTERACTIVE LU TABLE 
                        EQUIVALENCE (NCINLU,NCRTH(2)) 
C              NCAXLU - BUFFER ADDR OF AUX LU TABLE 
                        EQUIVALENCE (NCAXLU,NCRTH(3)) 
C              NCPAR1 - BUFFER ADDR OF FIRST PARTITION
                        EQUIVALENCE (NCPAR1,NCRTH(4)) 
C              NCNAME - APPLICATION NAME (2 WDS)
                        DIMENSION NCNAME(2) 
                        EQUIVALENCE (NCNAME,NCRTH(5)) 
C              NCSCOD - SECURITY CODE 
                        EQUIVALENCE (NCSCOD,NCRTH(7)) 
C              NCCRNO - CARTRIDGE NO. 
                        EQUIVALENCE (NCCRNO,NCRTH(8)) 
C              NCEMAS - EMA SIZE IN KWDS
                        EQUIVALENCE (NCEMAS,NCRTH(9)) 
C              NCMSEG - MSEG SIZE IN KWDS 
                        EQUIVALENCE (NCMSEG,NCRTH(10))
C              NCPARS - PARTITION SIZE IN KWDS
                        EQUIVALENCE (NCPARS,NCRTH(11))
C              NCPARN - PARTITION NO. 
                        EQUIVALENCE (NCPARN,NCRTH(12))
C              NCLOGD - LOGGING DEVICE LU OR FILENAME (5 WDS) 
                        DIMENSION NCLOGD(5) 
                        EQUIVALENCE (NCLOGD(1),NCRTH(13)) 
C              NCTUSP - TUS NAME OF STARTING PROCESS (3 WDS)
                        DIMENSION NCTUSP(3) 
                        EQUIVALENCE (NCTUSP(1),NCRTH(18)) 
C              NCSTCK - STACK LENGTH
                        EQUIVALENCE (NCSTCK,NCRTH(21))
C              NCINIP - TUS NAME OF INITIAL PROCESS (3 WDS) 
                        DIMENSION NCINIP(3) 
                        EQUIVALENCE (NCINIP(1),NCRTH(22)) 
C              NCLUIN - LU FOR INITIAL PROCESS
                        EQUIVALENCE (NCLUIN,NCRTH(25))
C              NCDBNO - NO. OF DATA BASES 
                        EQUIVALENCE (NCDBNO,NCRTH(26))
C 
C NOTE: THE FOLLOWING VARIABLES ARE EQUIVALENCED TO "NCRTH" FOR USE 
C       BY TMSG5. 
C 
C              IEXFL  - 
                        EQUIVALENCE (IEXFL,NCRTH(2101)) 
C              IPTR   - 
                        EQUIVALENCE (IPTR,NCRTH(2102))
C              NBSCR  - 
                        EQUIVALENCE (NBSCR,NCRTH(2103)) 
C              IFSCR  - 
                        EQUIVALENCE (IFSCR,NCRTH(2104)) 
C              ILAST  - 
                        EQUIVALENCE (ILAST,NCRTH(2105)) 
C              IFLG   - 
C                       DIMENSION IFLG(29)
C                       EQUIVALENCE (IFLG(1),NCRTH(2106)) 
C              IPRVS  - 
C                       DIMENSION IPRVS(29) 
C                       EQUIVALENCE (IPRVS(1),NCRTH(2135))
C              IBUFR  - DATA BUFFER USED BY SUBROUTINE "TMPRS"
                        DIMENSION IBUFR(62) 
                        EQUIVALENCE (IBUFR(1),NCRTH(2164))
C              ITEMP  - 
                        DIMENSION ITEMP(3)
                        EQUIVALENCE (ITEMP(1),NCRTH(2226))
C              ITOSC  - 
                        EQUIVALENCE (ITOSC,NCRTH(2229)) 
C 
C*********************************************************************
CCB3
C 
C-----LABEL COMMON # 4  I/O BUFFER (MAX SIZE = 100 WORDS) 
C 
CCB4
C*********************************************************************
C 
C-----LABELED COMMON # 4  BUFFER USED IN CREATION PHASE & ERROR FLAG
C                       OR I/O BUFFER USED IN THE INTERACTIVE DEFINITION
C                       PHASE.
C 
      COMMON /TMGC4/IERFL,IERNB,IERTN,IERMS(7),IRLOC(70),ITRSF(20)
C 
C NOTE: THE VARIABLES IN THIS COMMON ARE EQUIVALENCED TO "IOBUF"
C       FOR USE BY TMSG4 & TMSG5. 
C 
      DIMENSION IOBUF(100)
      EQUIVALENCE (IOBUF(1),IERFL)
C     IERFL  -
C     IERNB  -
C     IERMS  -
C     IRLOC  -
C     ITRSF  -
C 
C*********************************************************************
CCB4
C 
C 
      LOGICAL GETBK,TMPRS 
      LOGICAL IEXFL 
C 
C     CURRENT JOB ON PROCESS
C 
      IF(IJOB.EQ.2) GOTO 90 
      IF(IJOB.EQ.3) GOTO 40 
      IF(IJOB.NE.0) STOP 5000 
C 
C     INTERACTIVE LOGICAL UNIT  (HP 3070 DEVICE)
C 
10    ISCRN=1 
      CALL ILPRS(IOFST,IEND)
      IF(IEND.EQ.3)  GOTO 65
      IF(IEND.NE.1) GOTO 60 
      IOFST=0 
C 
      IF(IMOTR .NE. 1)  GOTO 75 
C 
C     TMS-SUBROUTINES AND LIBRARIES  (USER WRITTEN MODULES) 
C 
40    ISCRN=3 
      IF( TMPRS(IOFST,LENGH,4,IEND,IFLD) )  GOTO 85 
      IF(IEND.EQ.1) GOTO 100
      IF(IEND.NE.3) GOTO 60 
C-----PREVIOUS SCREEN OK ?
      IF(IMOTR .NE. 1)  GOTO 65 
      IOFST=0 
      GOTO 10 
C 
C     RETURN FROM ILPRS, TMPRS
C 
60    IF(IEND.EQ.0) GOTO 70 
      IF(IEND.EQ.2.OR.IEND.EQ.1) GOTO 80
      STOP 5002 
C 
C     PREVIOUS SCREEN NEED TO ACTUALLY CHANGE THE SCREEN, 
C     IF NOT ALLOWED, RE-ISSUE THE SAME ONE AND PRINT ERROR ! 
C 
65    IEND=-33
C 
C     INTERACTIVE PROCESS, PRINT THE SCREEN.
C 
70    CONTINUE
      IF(ISCRN.NE.1)GO TO 73
      JOFST=IOFST+ISZSC 
      CALL ORDLU(NCRTH,JOFST,64)
73    CALL TMGSC(3,ISCRN,IOFST,IEND,2)
C 
C     END OF INTERACTIVE PROCESS, ABORT OR PARTIAL PROCESS
C 
75    IEND=1
80    CALL TMGSC(0,0,0,IEND,IJOB) 
C 
C     ERROR PROCESSING: 
C 
84    IEND=-IEND
      IFLD=1
85    CALL TMPGE(IEND,IFLD) 
C 
C     SET UP INPUT LENGTH 
C 
90    LENGH=0 
      IF(IEND .LT. 0)  GOTO 84
      IF(ISCRN.EQ.1) LENGH=103
C 
C     FOR SCREEN 3 THE LENGTH OF THE READ IS 127 BUT AFTER THE
C     READ THE INPUT BUFFER WILL BE REFORMATTED TO LOOK LIKE A
C     BUFFER OF 140 MADE UP OF 20 SUBROUTINES AND 3 LIBRARIES 
C     INSTEAD OF THE ACTUAL 19 SUBROUTINES AND 2 LIBRARIES READ.
C 
      IF(ISCRN.EQ.3) LENGH=127
      IF(LENGH.EQ.0) STOP 5003
C 
C     WAIT FOR INPUT FROM THE 2645
C 
95    IF(GETBK(LU,IOBUF,LENGH)) GOTO 70 
C 
C     DISPATCH TO ANALYSIS CODE 
C 
      IF(ISCRN .EQ. 1)  GOTO 10 
      IF(ISCRN .NE. 3)  GOTO 100
C 
C     REFORMAT THE INPUT BUFFER NOW FOR SCREEN 3, RESET LENGH TO 140. 
C 
      DO 957 IJK=127,115,-1 
      IHOLD=IGET1(IOBUF,IJK)
      CALL PUTCA(IOBUF,IHOLD,IJK+6) 
957   CONTINUE
      IOBUF(58)=2H
      IOBUF(59)=2H
      IOBUF(60)=2H
      CALL PUTCA(IOBUF,1H,120) 
      CALL PUTCA(IOBUF,1H,134) 
      IOBUF(68)=2H
      IOBUF(69)=2H
      IOBUF(70)=2H
      LENGH=140 
      GO TO 40
C 
C     DONE REFORMATTING THE BUFFER FROM SCREEN 3
C 
C     INTERACTIVE PROCESS: CONTINUED WITH IMAGE & MAIN DEFINITION 
C 
100   IF(IMOTR .NE. 1)  GOTO 75 
      ISCRN=0 
      IOFST=0 
      IJOB=0
      CALL TMGSC(4,ISCRN,IOFST,IEND,IJOB) 
C 
C     DUMMY CALL TO MAIN  !!
C 
      CALL TMPGN
      END 
      SUBROUTINE ILPRS(IOFST,IEND),92080-16457 REV.2026  790626 
C 
C 
C     *************************************************** 
C     *                                                 * 
C     * THIS SUBROUTINE PROCESS SCREEN NUMBER 1 CONTENT * 
C     * BEFORE TRANLATING IT IN TABLE "NCRTH".          * 
C     *                                                 * 
C     * IF IOFST=0 : INITIALISATION TAKE PLACE          * 
C     *                                                 * 
C     * IF IOFST#0 : PENDING SCREEN IS PROCESSED AND A  * 
C     * MESSAGE CAN BE SENT TO POINT AT AN ERROR.       * 
C     *                                                 * 
C     * WHEN A SCREEN IS RECEIVED, UNCOMPLETELY FILLED, * 
C     * AND IS GOOD, IT IS CONSIDERED AS THE LAST ONE   * 
C     * OF THE SCREEN NUMBER ONE FAMILY AND NCRTH(2000) * 
C     * IS DECONTRACTED IN THE STANDARD FORMAT INTO THE * 
C     * NCRTH(45) INITIAL TABLE AND IEND IS SET TO "1". * 
C     * IF ABORT KEY WAS DEPRESSED IEND IS SET TO "2".  * 
C     * IF PREVIOUS SCREEN KEY WAS USED, TO GO BACK     * 
C     * BEFORE THIS SCREEN, IEND IS SET TO "3"          * 
C     *                                                 * 
C     *************************************************** 
C 
C 
C-----LABEL COMMON # 1  TERMINAL LU 
C 
CCB1
C*********************************************************************
C 
C-----LABELED COMMON # 1  GENERAL INFORMATION 
C 
      COMMON /TMGC1/LU,LUPRT,LUOUT,ISYTP,IPARAM(5)
C 
C     LU     - USER TERMIAL LU
C     LUPRT  - LISTING LU 
C     LUOUT  - NOT USED 
C     ISYTP  - SYSTEM TYPE (MUST BE .EQ. -9, RTE-IV)
C     IPARAM - TMPGN OPERATING PARAMETERS:
C              ISCRN  - CURRENT SCREEN NO.
                        EQUIVALENCE (ISCRN,IPARAM(1)) 
C              IOFST  - OFFSET INTO BUFFER NCRTH
C                       EQUIVALENCE (IOFST,IPARAM(2)) 
C              IEND   - INTERACTIVE OPERATION INDICATOR 
C                       0 - CURRENT PROCESS 
C                       1 - END OF PROCESS
C                       2 - ABORT TMPGN 
C                       3 - PREVIOUS SCREEN 
C                       EQUIVALENCE (IEND,IPARAM(3))
C              IJOB   - TMS FUNCTION INDICATOR
C                       0 - DEFINE (INT. AND AUX. LU'S, AND T.U.S.) 
C                       1 - SCREEN HAS BEEN PRINTED, PERFORM ANALYSIS 
C                       3 - DEFINE T.U.S. INTO USER PARTITION 
                        EQUIVALENCE (IJOB,IPARAM(4))
C 
C*********************************************************************
CCB1
C 
C-----LABEL COMMON # 3  BUFFER AREA 
C 
CCB3
C*********************************************************************
C 
C-----LABELED COMMON # 3  BUFFER AREA 
C 
      COMMON /TMGC3/IREFC,ILUGH,INTMS,ILPRG,IDECL,ILGMX,NBPRO 
     .             ,NCRTH(2540) 
C 
C     IREFC  -
C     ILUGH  -
C     INTMS  -
C     ILPRG  -
C     IDECL  -
C     ILGMX  -
C     NBPRO  -
C     NCRTH  - OUTPUT FILE BUFFER:
C              NCNOWD - NO. OF WORDS IN FILE
                        EQUIVALENCE (NCNOWD,NCRTH(1)) 
C              NCINLU - BUFFER ADDR OF INTERACTIVE LU TABLE 
                        EQUIVALENCE (NCINLU,NCRTH(2)) 
C              NCAXLU - BUFFER ADDR OF AUX LU TABLE 
                        EQUIVALENCE (NCAXLU,NCRTH(3)) 
C              NCPAR1 - BUFFER ADDR OF FIRST PARTITION
                        EQUIVALENCE (NCPAR1,NCRTH(4)) 
C              NCNAME - APPLICATION NAME (2 WDS)
                        DIMENSION NCNAME(2) 
                        EQUIVALENCE (NCNAME,NCRTH(5)) 
C              NCSCOD - SECURITY CODE 
                        EQUIVALENCE (NCSCOD,NCRTH(7)) 
C              NCCRNO - CARTRIDGE NO. 
                        EQUIVALENCE (NCCRNO,NCRTH(8)) 
C              NCEMAS - EMA SIZE IN KWDS
                        EQUIVALENCE (NCEMAS,NCRTH(9)) 
C              NCMSEG - MSEG SIZE IN KWDS 
                        EQUIVALENCE (NCMSEG,NCRTH(10))
C              NCPARS - PARTITION SIZE IN KWDS
                        EQUIVALENCE (NCPARS,NCRTH(11))
C              NCPARN - PARTITION NO. 
                        EQUIVALENCE (NCPARN,NCRTH(12))
C              NCLOGD - LOGGING DEVICE LU OR FILENAME (5 WDS) 
                        DIMENSION NCLOGD(5) 
                        EQUIVALENCE (NCLOGD(1),NCRTH(13)) 
C              NCTUSP - TUS NAME OF STARTING PROCESS (3 WDS)
                        DIMENSION NCTUSP(3) 
                        EQUIVALENCE (NCTUSP(1),NCRTH(18)) 
C              NCSTCK - STACK LENGTH
                        EQUIVALENCE (NCSTCK,NCRTH(21))
C              NCINIP - TUS NAME OF INITIAL PROCESS (3 WDS) 
                        DIMENSION NCINIP(3) 
                        EQUIVALENCE (NCINIP(1),NCRTH(22)) 
C              NCLUIN - LU FOR INITIAL PROCESS
                        EQUIVALENCE (NCLUIN,NCRTH(25))
C              NCDBNO - NO. OF DATA BASES 
                        EQUIVALENCE (NCDBNO,NCRTH(26))
C 
C NOTE: THE FOLLOWING VARIABLES ARE EQUIVALENCED TO "NCRTH" FOR USE 
C       BY TMSG5. 
C 
C              IEXFL  - 
                        EQUIVALENCE (IEXFL,NCRTH(2101)) 
C              IPTR   - 
                        EQUIVALENCE (IPTR,NCRTH(2102))
C              NBSCR  - 
                        EQUIVALENCE (NBSCR,NCRTH(2103)) 
C              IFSCR  - 
                        EQUIVALENCE (IFSCR,NCRTH(2104)) 
C              ILAST  - 
                        EQUIVALENCE (ILAST,NCRTH(2105)) 
C              IFLG   - 
C                       DIMENSION IFLG(29)
C                       EQUIVALENCE (IFLG(1),NCRTH(2106)) 
C              IPRVS  - 
C                       DIMENSION IPRVS(29) 
C                       EQUIVALENCE (IPRVS(1),NCRTH(2135))
C              IBUFR  - DATA BUFFER USED BY SUBROUTINE "TMPRS"
                        DIMENSION IBUFR(62) 
                        EQUIVALENCE (IBUFR(1),NCRTH(2164))
C              ITEMP  - 
                        DIMENSION ITEMP(3)
                        EQUIVALENCE (ITEMP(1),NCRTH(2226))
C              ITOSC  - 
                        EQUIVALENCE (ITOSC,NCRTH(2229)) 
C 
C*********************************************************************
CCB3
C 
C-----LABEL COMMON # 4  I/O BUFFER ( MAX SIZE = 100 WORDS  )
C 
CCB4
C*********************************************************************
C 
C-----LABELED COMMON # 4  BUFFER USED IN CREATION PHASE & ERROR FLAG
C                       OR I/O BUFFER USED IN THE INTERACTIVE DEFINITION
C                       PHASE.
C 
      COMMON /TMGC4/IERFL,IERNB,IERTN,IERMS(7),IRLOC(70),ITRSF(20)
C 
C NOTE: THE VARIABLES IN THIS COMMON ARE EQUIVALENCED TO "IOBUF"
C       FOR USE BY TMSG4 & TMSG5. 
C 
      DIMENSION IOBUF(100)
      EQUIVALENCE (IOBUF(1),IERFL)
C     IERFL  -
C     IERNB  -
C     IERMS  -
C     IRLOC  -
C     ITRSF  -
C 
C*********************************************************************
CCB4
C 
      DIMENSION NAME(3),IBUFF(192),IPOB(3)
      LOGICAL JPAR,ISBTW,OKABT,GETBK
C 
C 
      ISZSC=64
      ILONG=104 
      IF(IOFST.NE.0) GOTO 30
C 
C     FIRST TIME ILPRS IS CALLED
C 
      IEND=0
      CALL CTILU
      IOFST=IDECL 
      RETURN
C 
C     INTERACTIVE LU# PHASE IS PROCESSING 
C 
30    IEND=0
      CALL NUL(IBUFF,192) 
      IFIN=0
      IPRVS=0 
C 
C     ACQUISITION 
C 
      DO 90 I=1,(ISZSC/2)-3,4 
      J=I 
      IF(JPAR(IOBUF,ILONG,I,IPOB,2,IFLG,IBUFF(I))) GOTO 200 
      IFLG1=IFLG
      IBUFF(I+1)=0
      IF(JPAR(IOBUF,ILONG,I+1,IPOB,2,IFLG,IBUFF(I+1))) GOTO 200 
      IP=I+1
      IFLG2=IFLG
      IBUFF(I+2)=0
      IF(JPAR(IOBUF,ILONG,I+2,IPOB,4,IFLG,IBUFF(I+2))) GOTO 200 
      IQ=I+2
      IFLG3=IFLG
      IFLG4=2H
      IF(JPAR(IOBUF,ILONG,I+3,IBUFF(I+3),1,IFLG,IPOB))GO TO 200 
      IR=I+3
      IFLG4=IFLG
      IF(IFLG1+IFLG2+IFLG3+IFLG4.NE.0) GOTO 35
C 
C     CHECK FOR PREVIOUS SCREEN OR ABORT COMMAND
C 
      IBUFF(I)=0
      IBUFF(I+1)=0
      IBUFF(I+2)=0
      IBUFF(I+3)=2H 
      IF(J.NE.(ISZSC/2)-3) J=J+4
      DO 33 II=J,(ISZSC/2)-3,4
      IF(JPAR(IOBUF,ILONG,II,IPOB,2,IFLG,IBUFF(II))) GOTO 34
      IF(JPAR(IOBUF,ILONG,II+1,IPOB,2,IFLG,IBUFF(II+1))) GOTO 34
      IF(JPAR(IOBUF,ILONG,II+2,IPOB,4,IFLG,IBUFF(II+2)))GO TO 34
      IBUFF(II+3)=2H
      IF(JPAR(IOBUF,ILONG,II+3,IBUFF(II+3),1,IFLG,IPOB)) GOTO 34
33    CONTINUE
      IF(I.NE.1.OR.IOFST.NE.IDECL) GOTO 3033
      J=1 
      CALL TMPGE(43,J)
      GOTO 110
3033  IFIN=1
      CALL NUL(IBUFF(J),192-J)
      CALL MOVEW(IBUFF,NCRTH((IOFST+2)/2),ISZSC/2)
      IOFST=IOFST+ISZSC 
      GOTO 92 
C 
C     ABORT OR PREVIOUS SCREEN ( WITH INPUT ) 
C 
34    CONTINUE
      IPRVS=0 
      IF(IFLG.NE.8) GOTO 330
      CALL NUL(IBUFF(J),192-J)
      IPRVS=1 
      GOTO 92 
C 
C     CHECK DEFINED LU, 1<LU#<LUMAX, LU1<LU2, DEFINED TYPE
C 
35    IF(IFLG1.EQ.0) GOTO 60
      IF(IFLG1.NE.1) GOTO 70
      LUMAX=IGET(1653B) 
      CALL CNUMD(LUMAX,IPOB)
      IF(ISBTW(IBUFF(I),1,63))GOTO 76 
      IF(ISBTW(IBUFF(I),1,LUMAX)) GO TO 75
      J=I+1 
      IF(IFLG2.EQ.0) IBUFF(I+1)=0 
      IF(IFLG2.NE.1.AND.IFLG2.NE.0) GOTO 70 
      IF(IBUFF(I+1).LT.IBUFF(I).AND.IBUFF(I+1).NE.0) GOTO 85
      IF(ISBTW(IBUFF(I+1),0,63)) GO TO 76 
      IF(ISBTW(IBUFF(I+1),0,LUMAX)) GOTO 75 
C 
C     CHECK THAT LU# IS USING DVA47 OR DVR07
C 
42    DO 55 ILOP=IBUFF(I),IBUFF(I+1)
      IEQT=IAND(IGET(IGET(1652B)+ILOP-1),77B) 
      IDVTYP=IAND(IGET(IGET(1650B)+((IEQT-1)*15)+4),37400B)/256 
      IF(IDVTYP.EQ.47B .OR. IDVTYP.EQ.07B)  GOTO 55 
      CALL CNUMD(ILOP,IPOB) 
46    CALL TMPGE(12,J-1,IPOB(3))
      GOTO 110
55    CONTINUE
C 
C     CHECK LU# IS NOT 1,2,3,CRT# 
C 
      IF(IBUFF(I+1).EQ.0) IBUFF(I+1)=IBUFF(I) 
      ICHLU=1 
      DO 50 ILOP=1,4
      IF(ISBTW(ICHLU,IBUFF(I),IBUFF(I+1))) GOTO 40
      CALL CNUMD(ICHLU,IPOB)
      GOTO 46 
40    IF(ILOP.EQ.1.OR.ILOP.EQ.2) ICHLU=ICHLU+1
      IF(ILOP.EQ.3) ICHLU=LU
50    CONTINUE
C 
C     IS THERE A DELETE OPERATION TO PERFORM ?
C 
      J=I+3 
      K=I+2 
      IF(IFLG4.NE.3.AND.IFLG4.NE.0) GOTO 80 
      IF(IFLG4.EQ.3.AND.IBUFF(I+3).NE.2HX )GO TO 80 
      IF(IFLG4.EQ.3.AND.IBUFF(I+3).EQ.2HX ) IBUFF(I+3)=-1 
      IF(IFLG3.EQ.3)GO TO 86
      IF(IBUFF(I+2).LT.0.OR.IBUFF(I+2).GT.9999)GO TO 87 
      IF((IFLG4.EQ.0.OR.IFLG4.EQ.3).AND.IBUFF(I+2).EQ.0)IBUFF(I+2)=10000
      IF(IBUFF(I+3).NE.-1.AND.IBUFF(I+2).EQ.0)GO TO 80
      IF(IBUFF(4).EQ.-1 .AND. IOFST.EQ.IDECL)  GOTO 65
90    CONTINUE
      GOTO 91 
C 
C     TMPGE MESSAGES
C 
60    CALL TMPGE(10,J)
      GOTO 110
65    CALL TMPGE(11,1)
      GOTO 110
70    CALL TMPGE(3,J) 
      GOTO 110
76    CALL CNUMD(63,IPOB) 
75    CALL TMPGE(44,J,IPOB(3))
      GOTO 110
80    CALL TMPGE(19,J)
      GOTO 110
85    CALL TMPGE(41,J)
      GOTO 110
86    CALL TMPGE(2,K) 
      GO TO 110 
87    CALL TMPGE(21,K)
      GO TO 110 
C 
91    CONTINUE
      CALL MOVEW(IBUFF,NCRTH((IOFST+2)/2),ISZSC/2)
      IOFST=IOFST+ISZSC 
C 
C     CHEK FOR DUPLICATE LU#
C 
92    CONTINUE
      CALL DUPLU(NCRTH(2050),((IOFST-IDECL)/2),IFILD,LUER)
      IF(LUER.EQ.0) GOTO 100
      IF(LUER.EQ.-1) GOTO 95
      CALL TMPGE(8,IFILD,LUER)
93    IOFST=IOFST-ISZSC 
      GOTO 110
95    CALL TMPGE(11,IFILD)
      GOTO 93 
C 
C     NEXT OR PREVIOUS SCREEN 
C 
100   CONTINUE
      IF(IFIN.EQ.1) GOTO 340
      IF(IPRVS.EQ.1) GOTO 300 
      RETURN
C 
C     ******************************************************
C 
C 
C     WAITING FOR OPERATOR INPUT
C 
110   IF(.NOT.GETBK(LU,IOBUF,ILONG-1)) GOTO 30
      RETURN
C 
C     SPECIAL FUNCTION KEYS PROCESS 
C     ------------------------------
C 
C     ABORT OR PREVIOUS SCREEN ( WITHOUT INPUT )
C 
200   CONTINUE
      IF(IFLG.NE.9) GOTO 210
      IF(.NOT.OKABT(LU)) RETURN 
C-----OPERATOR WANTS TO ABORT, DO IT
205   IEND=2
      RETURN
C 
210   CONTINUE
      IF(IFLG.EQ.8.AND.IOFST.EQ.IDECL) GOTO 320 
      IF(IFLG.EQ.8.AND.IOFST.NE.IDECL) IOFST=IOFST-ISZSC
      IF(IFLG.EQ.8) RETURN
      GOTO 320
C 
C     PREVIOUS SCREEN ( WITH INPUT )
C 
300   CONTINUE
      CALL NUL(NCRTH(IREFC),ILUGH)
      CALL MOVEW(IBUFF,NCRTH((IOFST+2)/2),ISZSC/2)
      IF(IOFST.EQ.IDECL) GOTO 320 
      IOFST=IOFST-ISZSC 
      RETURN
C 
C     PREVIOUS SCREEN NEED AN OTHER SCREEN, BEFORE LU DEFINITION
C 
320   IEND=3
      RETURN
C 
C     ABORT COMMAND 
C 
330   CONTINUE
      IF(IFLG.NE.9) GOTO 335
      IF( OKABT(LU) )  GOTO 205 
C 
C     REJECT ILLEGAL CHARACTER. 
C 
335   CONTINUE
      CALL TMPGE(34,J)
      GOTO 110
C 
C     END OF INTERACTIVE LU PROCESS 
C 
340   CALL NUL(NCRTH(IREFC),ILUGH)
      CALL NUL(NCRTH((IOFST+2)/2),4)
      CALL DPILU
      IF(NCRTH(IREFC) .NE. 0)  GOTO 350 
      CALL TMPGE(43,1)
      GOTO 93 
350   IEND=1
      RETURN
      END 
      END$