FTN4
      PROGRAM QY02(5,90),92069-16060 REV.1940 790523
C 
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     SOURCE:    92069-18065
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C  REPORT SERVICE ROUTINE 
C     MADE UP OF
C         1. QS02 
C         2. QS03 
C         3. QS04 
C         4. QS05 
C         5. QS06 
C         6. QS15 
C         7. QS12 
C         8. QS19 
C         9. QS20 
C 
C 
C 
C 
C   THE STRUCTURE OF THE SEGEMENTS IS DIAGRAMED BELOW.
C 
C 
C                QS02 - PICKS UP THE REPORT STATEMENTS
C                  !
C       -----------!
C       !          !
C     QS03         !     REPORT ALL INITIALIZE
C       !          !
C     QS18         !     PRINT ALL
C       !          !
C       QS         !
C                QS04 - VERIFIES SYNTAX OF EACH STATEMENT 
C                  !
C               --------
C               !      !
C              QS05    !   PREPARES FOR SORT
C               !      !
C              QS19    !   SORTS THE RECORDS
C               !      !
C               --------
C                  !
C                QS06      PREPARES TO PRINT
C                  !
C          ----> QS15 --> QS    CHECKS FOR LEVEL BREAKS 
C          !       !
C          !    --------
C          !    !      !
C          !  QS12     !    PRINTS TOTALS ON BREAKS 
C          !    !      !
C          !    --------
C          !       !
C          !     QS20        TOTALS EACH FIELD AND PRINTS 
C          !       !              DETAILS OR GROUP BREAKS 
C          <------- 
C 
C 
C 
C 
C  REPORT TABLE FORMAT IN ARRAY SS(6,100).
C  THIS TABLE IS BUILT BY QS02, LOGIC 
C  CHECKED BY QS04, AND SORTED (IF NEEDED)
C  BY QS05. 
C 
C  EACH ROW OF ARRAY S CONTAINS INFORMATION 
C  ABOUT EACH REPORT STATEMENT: 
C 
C     1. REPORT STATEMENT TYPE
C         10-15 SORT STATEMENT
C         21-25 HEADER STATEMENT
C         31-36 TOTAL STATEMENT 
C         41-46 GROUP STATEMENT 
C         50-59 DETAIL STATEMENT
C         60-69 EDIT MASKS
C 
C     2. DATA-ITEM NUMBER 
C 
C     3. LITERAL POINTER TO QSKIB.  QSKIB IS AN RTE TRACK 
C        WHICH CONTAINS ALL LITERALS OR EDIT
C        MASKS IN A2 FORMAT, PRECEDED BY IT'S 
C        CHARACTER LENGTH.
C 
C     4. END PRINT POSITION 
C 
C     5. REPORT OPTION 1
C        UNITS PLACE     = SPACE BEFORE (0-5) 
C        TENS PLACE      = SPACE AFTER  (0-5) 
C        HUNDREDS PLACE  = SKIP BEFORE (0-1)
C        THOUSANDS PLACE = SKIP AFTER (0-1) 
C        TEN THOUSANDS   = ADD (0-1)
C 
C     6. REPORT OPTION 2
C        UNITS PLACE  = O NO EDIT  = 1 ZERO SUPPRESS
C        60 - 69  EDIT MASK 
C        HUNDREDS PLACE  = COUNT (0-1)
C        THOUSANDS PLACE = AVERAGE (0-1)
C 
C     7. OFFSET INTO THE LIST-ARRAY 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C     T ARRAY IS USED TO HOLD INDEX INTO LIST-ARRAY FOR SORT FIELDS 
C 
C     U ARRAY IS USED TO FOR TOTAL COUNT
C        1. FIELD MAP          (1,I)
C        2. ACCUMULATE COUNTS  (2,I) - (7,I)
C 
C     ATOTAL ARRAY IS FOR TOTAL ADD 10*5
C       NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON 
C 
C     LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER
C 
C         FIRST ENTRY IS DIFFERENT THAN THE OTHERS
C            1. CONTAINS # OF ENTRIES IN ARRAY
C            2 - 5. ARE EMPTY 
C            6. CONTAINS THE # OF SORT ITEMS
C                 NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY
C 
C         OTHER ENTRIES 
C            1. ITEM NUMBER 
C            2. ITEM TYPE 
C            3. ITEM LENGTH 
C            4. ELEMENT COUNT 
C            5. OFFSET INTO DBMS BUFFER 
C            6. CONTAIN THE ITEM NUMBER IFF IT IS A SORT ITEM 
C 
C 
C 
C    LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK
C     STRINGS 
C 
C    LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C ANY CHANGE TO IBSZ MUST CHANGE THE SIZE OF ISORT
C 
      INTEGER ISTAT(10) 
      DIMENSION INFO(13)
      INTEGER R7,Z,Z1,R5
      INTEGER PAGE(3) 
      INTEGER A,B,D,E,F,G,H,TCHAR,ASTER,DOLLAR,X
      INTEGER DZERO(2)
      INTEGER ERR1(15)
      INTEGER ERR2(20)
      INTEGER ERR3(21)
      INTEGER ERR4(7) 
      INTEGER ERR5(13)
      INTEGER ERR6(16)
      INTEGER ERR7(14)
      DIMENSION NAME(2) 
      INTEGER END(2)
      INTEGER ALL(2)
      INTEGER REPORT(3) 
C 
      LOGICAL MEMBR 
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ 
      INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM 
      INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR 
      INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN
      LOGICAL BREAK 
      INTEGER IPFLAG,IOFLAG,RMOTE 
      LOGICAL BATCH,XQBCH 
      INTEGER PAGCNT,LNCNT
      INTEGER PAGLEN,COLLIM 
      REAL    RRCNT 
      REAL    SELT,RSEC 
      INTEGER IPTR
      REAL    RCOUNT
      INTEGER S,R3,TRKNM,IDILU
      INTEGER R6
      REAL    ATOTAL
      INTEGER LIST,L,T,U
      INTEGER LEVSTR,LEVLEN 
      INTEGER IBUFF 
      INTEGER SS(7,100) 
C 
      COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145)
      COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) 
      COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR
      COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN
      COMMON BREAK
      COMMON IPFLAG,IOFLAG,RMOTE
      COMMON BATCH,XQBCH
      COMMON PAGCNT,LNCNT 
      COMMON PAGLEN,COLLIM
      COMMON RRCNT
      COMMON SELT(64),RSEC
      COMMON IPTR 
      COMMON RCOUNT 
      COMMON S(15,50),R3,TRKNM,IDILU
      COMMON R6 
      COMMON ATOTAL(6,5)
      COMMON LIST(101,6),L(7),T(5),U(7,5) 
      COMMON LEVSTR(66,5),LEVLEN(5) 
      COMMON IBUFF(2048)
C 
      EQUIVALENCE (S,SS)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      DATA PAGE/2HPA,2HGE,2HNO/ 
      DATA A/101B/
      DATA B/102B/
      DATA D/104B/
      DATA E/105B/
      DATA F/106B/
      DATA G/107B/
      DATA H/110B/
      DATA IS/123B/ 
      DATA TCHAR/124B/
      DATA IZ/132B/ 
      DATA DOLLAR/44B/
      DATA X/130B/
      DATA ASTER/52B/ 
      DATA NINE/71B/
      DATA DZERO/0,0/ 
C RECORD HAS NOT YET BEEN FOUND 
      DATA ERR1/2H R,2HEC,2HOR,2HD ,2HHA,2HS ,2HNO, 
     1 2HT ,2HYE,2HT ,2HBE,2HEN,2H F,2HOU,2HND/ 
C COMAND TABLE OVERFLOW REISSUE COMMAND 
      DATA ERR2/2H C,2HOM,2HMA,2HND,2H T,2HAB,
     1 2HLE,2H O,2HVE,2HRF,2HLO,2HW,,2H R,
     2 2HEI,2HSS,2HUE,2H C,2HOM,2HMA,2HND/
C ILLEGAL DATA ITEM NAME OR TOO LOW ACCESS
      DATA ERR3/2H I,2HLL,2HEG,2HAL,2H D, 
     1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HE ,
     2 2HOR,2H T,2HOO,2H L,2HOW,2H A,2HCC,2HES,2HS /
C SYNTAX ERROR
      DATA ERR4/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / 
C EDIT MASK TABLE OVERFLOW
      DATA ERR5/2H E,2HDI,2HT ,2HMA,2HSK,2H T,
     1 2HAB,2HLE,2H O,2HVE,2HRF,2HLO,2HW /
C CONSTANT LITERAL TABLE OVERFLOW 
      DATA ERR6/2H C,2HON,2HST,2HAN,
     1 2HT ,2HLI,2HTE,2HRA,2HL ,2HTA, 
     2 2HBL,2HE ,2HOV,2HER,2HFL,2HOW/ 
C NO AVAILABLE SYSTEM TRACKS
      DATA ERR7/2H N,2HO ,2H A,2HVA,2HIL,2HAB,2HLE,2H S,2HYS,2HTE,2HM , 
     &  2HTR,2HAC,2HKS/ 
C CAN NOT TOTAL ASCII VALUES
C BAD SEGMENT 
      DATA NAME/2HNA,2HME/
      DATA END/2HEN,2HD;/ 
      DATA ALL/2HAL,2HL / 
      DATA REPORT/2HRE,2HPO,2HRT/ 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C     THIS PROGRAM IS A REPORT GENERATOR.  THE
C     SELECT-FILE CONTAINS THE RECORD NUMBERS 
C     OF THE RECORDS WHICH ARE TO BE REPORTED.
C 
C     THE ARRAY S IS A 7*100 ARRAY WHICH
C     CONTAINS ENCODED REPORT COMMANDS. 
C 
C     R3 - IS THE COUNTER FOR THE NUMBER OF 
C          COMMANDS ENTERED 
C     R6 - IS THE CONSTANT LITERAL AND
C          EDIT MASK DISK STORAGE INDEX IN BYTES
C     R7 - IS THE EDIT MASK COUNT 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
      IOFLAG = 0
C  CHECK FOR PROCEDURE
      CALL LSCAN(IB,I,J,K)
      IF(J-I.NE.3) GOTO 30
      IF(JSCOM(NAME,1,4,IB,I,IERR).NE.0) GO TO 30 
C  SCAN ACROSS =
      CALL LSCAN(IB,I,J,K)
      IF(K.NE.6) GO TO 180
C 
C  GET PROCEDURE NAME 
C 
      CALL GTPRC(REPORT,6,IERR) 
      IF(IERR .NE. 0) GOTO 140
      IOFLAG = 0
      CALL LSCAN(IB,I,J,K)
C 
C IS THE PROCEDURE SUPPOSE TO BE PRINTED? 
C 
30    CONTINUE
      IF(K .NE. 4) GOTO 35
      CALL LSCAN(IB,I,J,K)
      IOFLAG = 1
      CALL LSCAN(IB,I,J,K)
C 
C IS THIS A "REPORT ALL [,NL] " ? 
C 
35    CONTINUE
      IF(K .EQ. 5) GOTO 40
      IF(J-I .NE. 2) GOTO 180 
      IF(JSCOM(IB,I,J,ALL,1,IERR) .NE. 0) GOTO 180
      SNAM(2) = 2H03
      GOTO 310
C 
C REPORT ;
C 
40    CONTINUE
      IF(DCO(RRCNT,DZERO))50,50,60
50    CALL ERIO(2,ITTY,ERR1,15) 
      GOTO 140
C 
C GET SYSTEM TRACKS 
C 
60    CONTINUE
      CALL EXEC(100004B,1,TRKNM,IDILU,NSEC) 
      GOTO 65 
C 
C SEE IF ANY TRACKS WERE RETURNED BY THE EXEC CALL
C 
63    IF (TRKNM .GE. 0) GOTO 67 
C 
C OUTPUT "NO AVAILABLE SYSTEM TRACKS" 
C 
65    CONTINUE
      CALL ERIO(2,ITTY,ERR7,14) 
      GOTO 140
C 
C INITIALIZE S-ARRAY
C 
67    CONTINUE
      DO 70 J=1,100 
      DO 70,I=1,7 
      SS(I,J) = 0 
70    CONTINUE
C 
C INITIALIZE COUNTERS 
C 
      R3 = 1
      R6 = 1
      R7 = 0
C 
C IS THIS AN "END;" ? 
C 
80    CALL LSCAN(IB,I,J,K)
      CALL SGET(IB,I,ICHAR) 
      IF(J-I.NE.2) GOTO 90
      IF(JSCOM(IB,I,J,END,1,IERR).EQ.0) GO TO 290 
C 
C MUST BE REPORT STATEMENT
C 
90    CONTINUE
      IF(J-I.GT.1) GO TO 180
C 
C     SORT STATEMENT
C 
C     IS ICHAR AN "S"?
C 
      IF (ICHAR.NE.IS) GO TO 190
C 
C IS THERE A LEVEL #
C 
      IF (I.NE.J) GO TO 100 
      SS(1,R3) = 10 
      GO TO 110 
C 
C GET SORT LEVEL
C 
100   CALL SGET(IB,J,ICHAR) 
      ICHAR = ICHAR - 60B 
      IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 180 
      SS(1,R3) = 10 + ICHAR 
C 
C  SCAN FOR COMMA 
C 
110   CALL LSCAN(IB,I,J,K)
      IF (K.NE.4) GO TO 180 
C 
C  GET DATA ITEM NAME 
C 
      CALL LSCAN(IB,I,J,K)
      IF (K.NE.2) GO TO 180 
      IF (J-I.GT.5) GO TO 180 
      CALL SFILL(DINAM,1,6,40B) 
      CALL SMOVE(IB,I,J,DINAM,1)
      CALL DBINF(DBNAM,DINAM,101,ISTAT,INFO)
      IF(ISTAT .NE. 0) GOTO 160 
      DINUM = IABS(INFO)
C 
C IS THIS A MEMBER OF THE SET?
C 
      IF(MEMBR(DBNAM,DSNUM,DINUM,ISTAT)) GOTO 130 
120   IF(ISTAT .EQ. 0) GOTO 160 
C 
C DBMS - ERROR
C 
      QSERR = ISTAT 
      SNAM(2) = 2H23
      GOTO 300
C 
C PUT ITEM NUMBER IN THE SS-ARRAY 
C 
130   CONTINUE
      SS(2,R3) = DINUM
C 
C 
C PROCESSOR FOR SEMICOLN
C  AT END OF EACH REPORT STATEMENT
C 
C 
C  SCAN TO ;
      CALL LSCAN(IB,I,J,K)
      IF (K.NE.5) GO TO 180 
135   R3 = R3 +1
      IF (R3.LE.100) GO TO 80 
C  ERROR - COMMAND TABLE OVERFLOW 
      CALL ERIO(2,ITTY,ERR2,20) 
140   SNAM(2) = 2H
      GOTO 300
C 
C 
C 
C ERROR PROCESSORS
C 
C 
C 
C 
C  ERROR - CONSTANT LITERAL OVERFLOW
150   CALL ERIO(2,ITTY,ERR6,16) 
      GO TO 140 
C  ERROR - ILLEGAL DATA ITEM NAME 
160   CALL QRIO(2,ITTY,IB,-IEND)
      CALL ERIO(2,ITTY,ERR3,21) 
      GOTO 140
C  RETURN TO TTY FOR INPUT
C  ERROR - SYNTAX ERROR 
180   CALL SFILL(IMA,1,72,40B)
C 
C OUTPUT ERROR LINE IN MULTIPLE OF 72 COLUMNS 
C 
      IP = 1
185   CONTINUE
      IF (IEND .LE. 72) GOTO 187
      CALL QRIO(2,ITTY,IB(IP),-72)
      IP = IP + 36
      IEND = IEND - 72
      GOTO 185
C 
C WRITE LAST LINE 
C 
187   CONTINUE
      CALL QRIO(2,ITTY,IB(IP),-IEND)
      IF(I .GT.72) I = I-I/72*72
      CALL SPUT(IMA,I,136B) 
      CALL QRIO(2,ITTY,IMA,-I)
      CALL ERIO(2,ITTY,ERR4,7)
      GO TO 140 
C 
C     HEADER STATEMENT
C 
190   IF (ICHAR.NE.H) GO TO 240 
C 
C GET LEVEL NUMBER
C 
      CALL SGET(IB,J,ICHAR) 
      ICHAR = ICHAR - 60B 
      IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 180 
      SS(1,R3) = 20 + ICHAR 
C 
C  SCAN FOR COMMA 
C 
      CALL LSCAN(IB,I,J,K)
      IF (K.NE.4) GO TO 180 
C 
C  GET HEADER DATA TYPE 
C 
      CALL LSCAN(IB,I,J,K)
C 
C LITERAL ? 
C 
      IF (K.EQ.3) GO TO 210 
C 
C PAGE DECLARATION? 
C 
      IF(J-I.NE.5) GOTO 180 
      IF (JSCOM(PAGE,1,6,IB,I,IERR).NE.0) GO TO 180 
      SS(2,R3) = 1
C 
C THIS IS THE PRINT POSITION AND PRINT OPTION PROCESSOR 
C FOR TOTAL, GROUP, AND DETAIL STATEMENTS 
C 
C  SCAN FOR COMMA 
C 
200   CALL LSCAN(IB,I,J,K)
      IF (K.NE.4) GO TO 180 
C 
C  END PRINT POSITION 
C 
      CALL LSCAN(IB,I,J,K)
      CALL CATI(IB,I,J-I+1,INT,ISTAT) 
      IF(ISTAT.LT.0) GOTO 180 
      IF (INT.LT.1 .OR. INT.GT.132) GO TO 180 
      SS(4,R3) = INT
C 
C  CHECK FOR SEMI-COLON 
C 
      CALL LSCAN(IB,I,J,K)
      IF (K.EQ.5) GO TO 135 
C 
C     FORM REPORT OPTIONS 
C     PUT OPTIONS IN SS(5,N) AND SS(6,N)
C 
      CALL REPOP(I,J,IERR)
      IF (IERR) 180,135 
C 
C     LITERAL PROCESSOR 
C 
210   LEN = J - I + 1 
      IF(LEN.GT.0) GOTO 220 
      I=J+2 
      GOTO 180
220   CONTINUE
      IF(LEN.GT.COLLIM) GOTO 180
      IF(R6+LEN+2 .GT. IBSZ*2) GOTO 150 
C 
C     MOVE LITERAL TO BUFFER
C 
      SS(3,R3) = R6 
      CALL SMOVE(LEN,1,2,IBUFF,R6)
      R6 = R6 + 2 
      CALL SMOVE(IB,I,J,IBUFF,R6) 
      R6 = R6 + LEN 
      GO TO 200 
C 
C     TOTAL STATEMENT 
C 
240   K2 = 30 
      IF (ICHAR.NE.TCHAR) GO TO 270 
      CALL SGET(IB,J,ICHAR) 
C 
C IS THIS A "TF" STATEMENT? 
C 
      IF (ICHAR.NE.F) GO TO 250 
      ICHAR = 6 
      GO TO 260 
C 
C GET LEVEL NUMBER
C 
250   ICHAR = ICHAR - 60B 
      IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 180 
260   SS(1,R3) = K2 + ICHAR 
C     SCAN ACROSS TERMINATOR
      CALL LSCAN(IB,I,J,K)
      IF (K.NE.4) GO TO 180 
C  GET TOTAL DATA TYPE
      CALL LSCAN(IB,I,J,K)
C     TOTAL LITERAL 
      IF (K.EQ.3) GO TO 210 
C     DATA ITEM 
      IF (J-I.GT.5) GO TO 180 
      CALL SFILL(DINAM,1,6,40B) 
      CALL SMOVE(IB,I,J,DINAM,1)
      CALL DBINF(DBNAM,DINAM,101,ISTAT,INFO)
      IF(ISTAT .NE. 0) GOTO 160 
      DINUM = IABS(INFO)
      SS(2,R3) = DINUM
C 
C VERIFY THAT ITEM IS A MEMBER OF THE CORRECT SET 
C 
265   CONTINUE
      IF(MEMBR(DBNAM,DSNUM,DINUM,ISTAT)) GOTO 200 
      GOTO 120
C 
C     GROUP STATEMENT 
C 
270   K2 = 40 
      IF (ICHAR.NE.G) GO TO 280 
      CALL SGET(IB,J,ICHAR) 
      GO TO 250 
C 
C     DETAIL STATEMENT
C 
280   IF(ICHAR.NE.D) GO TO 320
      K2 = 50 
C 
C DOES THIS DETAIL STATEMENT HAVE A LEVEL 
C 
      ICHAR = 0 
      IF(I .EQ. J) GOTO 260 
C 
C NO, GET THE LEVEL NUMBER
C 
      CALL SGET(IB,J,ICHAR) 
      ICHAR = ICHAR-60B 
      IF(ICHAR .LT. 1 .OR. ICHAR .GT. 9) GOTO 180 
      GOTO 260
C 
C 
C 
C "END;" PROCESSOR
C 
C     CHECK FOR ; 
290   CALL LSCAN(IB,I,J,K)
      IF (K.NE.5) GO TO 180 
      R3 = R3 - 1 
      IF(R3.LE.0) GOTO 140
C 
C  WRITE IBUFF TO QSKIB 
C 
      CALL EXEC(2,IDILU,IBUFF,-R6,TRKNM,0)
C 
C  CALL LOGIC 
C 
      SNAM(2) = 2H04
300   CONTINUE
310   CONTINUE
      CALL LOAD(SNAM) 
C 
C 
C     EDIT STATEMENT
C 
320   IF(ICHAR.NE.E) GO TO 180
      CALL SGET(IB,J,ICHAR) 
      ICHAR = ICHAR - 60B 
      IF (ICHAR.LT.0 .OR. ICHAR.GT.9) GO TO 180 
      SS(1,R3) = 60 + ICHAR 
C     SCAN PAST COMMA 
      CALL LSCAN(IB,I,J,K)
      IF (K.NE.4) GO TO 180 
C     GET EDIT MASK 
      CALL LSCAN(IB,I,J,K)
      IF (K.NE.3) GO TO 180 
      Z = 0 
      DO 370 Z1=J,I,-1
      CALL SGET (IB,Z1,ICHAR) 
C  CHAR AN X - THEN ALPHA EDIT MASK 
      IF(ICHAR.EQ.130B) GOTO 380
C     CHECK FOR 'Z' 
      IF (ICHAR.NE.IZ) GO TO 340
      IF (Z.NE.1 .AND. Z.NE.0) GO TO 180
      Z = 1 
      GO TO 370 
C 
C     CHECK FOR '*' 
340   IF (ICHAR.NE.ASTER) GO TO 350 
      IF (Z.NE.2 .AND. Z.NE.0) GO TO 180
      Z = 2 
      GO TO 370 
C 
C     CHECK FOR '$' 
350   IF (ICHAR.NE.DOLLAR) GO TO 360
      IF (Z.NE.3 .AND. Z.NE.0) GO TO 180
      Z = 3 
      GO TO 370 
C 
C     CHECK FOR '9' 
360   IF (ICHAR.NE.NINE) GO TO 370
      IF (Z.NE.0) GO TO 180 
370   CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C  NUMERIC EDIT MASK
C     CHECK FOR NO MORE THAN 20 CHARACTERS
      IF(J-I.GT.19) GOTO 180
      IF(J-1.LT.0) GOTO 180 
      GOTO 390
C 
C  ALPHA EDIT MASK - MAX 132 CHARS
C 
380   IF(J-I+1 .GT. COLLIM) GOTO 180
C 
C     EDIT MASK 
C 
390   CONTINUE
      LEN = J - I + 1 
      IF(R6 + LEN + 2  .GT. IBSZ*2) GOTO 150
      IF(LEN .LT. 1) GOTO 180 
C 
C MOVE MASK TO BUFFER 
C 
      SS(3,R3) = R6 
      CALL SMOVE(LEN,1,2,IBUFF,R6)
      R6 = R6 + 2 
      CALL SMOVE(IB,I,J,IBUFF,R6) 
      R6 = R6 + LEN 
C 
C INCREASE THE EDIT MASK COUNT
C 
      R7 = R7 + 1 
      IF (R7.LE.10) GO TO 410 
C  ERROR - EDIT MASK OVERFLOW 
      CALL ERIO(2,ITTY,ERR5,13) 
      GO TO 140 
C     SCAN TO ';' 
410   CALL LSCAN(IB,I,J,K)
      IF (K.EQ.5) 135,180 
      END 
$