FTN4
      SUBROUTINE LIGHT(IQ,JVAL,JOUT,ISTAT,JFORM,ILITE), 92903-16307 REV.
     C1913  790111 1400 
C 
C     SOURCE 92903-18307
C 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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    PRGMR :JEAN CHARLES MIARD
C 
C*********************************************************************
C*                                                                   *
C*             THIS SUBROUTINE IS USED TO MANAGE 3070 LIGHTS ALLOC   *
C*  -ATION .                                                         *
C*             -FIRST IT RELEASES THE OLD LIGHT TAKEN BY THIS        *
C*              QUESTION OR DISPLAY IF ANY (COME BACK MODE).         *
C*             -IF THE ANSWER TO LIGHT # ? WAS A BLANK IT TAKES THE  *
C*              NEXT AVAILABLE LIGHT # (IF ANY)                      *
C*             -IF THE ANSWER TO LIGHT # ? WAS A NUMBER IT CHECKS    *
C*              THAT THE LIGHT CORRESPONDING TO THE NUMBER IS NOT    *
C*              ALREADY TAKEN BY ANOTHER QUESTION OR DISPLAY. IN     *
C*              THIS CASE IN A FIRST PASS (ISTAT=0) IT WILL CAUSE    *
C*              A WARNING MESSAGE TO BE PRINTED,IN A SECOND PASS     *
C*              (ISTAT=1) IT WILL ACCEPT THE NUMBER                  *
C*             -IF ALL OK THE LIGHT # IS STORED                      *
C*                                                                   *
C*       PARAMETERS:                                                 *
C*                     -IQ : QUESTION # POSITIVE FOR QUESTION      *
C*                                        NEGATIVE FOR DISPLAY       *
C*                     -JVAL : LIGHT # DESIRED (BINARY)              *
C*                     -JOUT : ANSWER TO QUESTION LIGHT # ? (ASCII)  *
C*                     -ISTAT: STATUS :                              *
C*                         - WHEN CALLING :                          *
C*                             0 NO WARNING ALREADY DONE             *
C*                             1 WARNING ALREADY DONE                *
C*                         - WHEN RETURNING :                        *
C*                             0 OK JOB DONE                         *
C*                            -1 NO MORE LIGHTS AVAILABLE            *
C*                            -2 ISSUE A WARNING                     *
C*                                                                   *
C*                     - JFORM :SOURCE BUFFER (LABELS)               *
C*                     - ILITE :LIGHT BUFFER ALLOCATION              *
C*                                                                   *
C*********************************************************************
C 
C 
C   DECLARATIONS  ************
C 
      DIMENSION JFORM(1),ILITE(1) 
C 
      LOGICAL CMPW
C 
C        *************************************************************
C        *                                                           *
C        *           DESRIPTION OF ILITE BUFFER   :                  *
C        *                                                           *
C        *       ILITE(I) :   I IS LIGHT #                           *
C        *                                                           *
C        *   IF ILITE(I) = 0 : LIGHT IS AVAILABLE .                  *
C        *               < 0 : LIGHT IS AN INDICATOR LIGHT           *
C        *                     (DISPLAY)  -ILIGHT(I) IS QUESTION #   *
C        *                     TO WHICH BELONG THE LIGHT .           *
C        *               > 0 : LIGHT IS A PROMPTING LIGHT            *
C        *                     (QUESTION) ILIGHT(I) IS QUESTION #    *
C        *                     TO WHICH BELONG THE LIGHT .           *
C        *               = -99 : LIGHT OCCUPIED BY SYSTEM            *
C        *                                                           *
C        *************************************************************
C 
      DATA JBYTES/140/
      DATA JWORDS/70/ 
C 
C RELEASE OLD LIGHT # 
C 
      DO 5000 I=1,15
      IF(ILITE(I).EQ.IQ) GO TO 5002 
5000  CONTINUE
      GO TO 5010
5002  DO 5006 J=1,20
      IF(J.EQ.IQ) GO TO 5003
      IL=NUMD(JFORM,(3+(J-1)*JBYTES),2) 
      IF(IL.EQ.I) GO TO 5008
5003  IF(J.EQ.-IQ) GO TO 5006 
      IL=NUMD(JFORM,(101+(J-1)*JBYTES),2) 
      IF(IL.EQ.I) GO TO 5009
5006  CONTINUE
      ILITE(I)=0
      GO TO 5010
5008  ILITE(I)=J
      GO TO 5010
5009  ILITE(I)=-J 
C 
C  USER WANTS NEXT AVAILABLE LIGHT
C 
5010  IF(JOUT.NE.2H  ) GO TO 5016 
      DO 5012 I=1,15
      IF(ILITE(I).EQ.0) GO TO 5014
5012  CONTINUE
      ISTAT=-1
      RETURN
5014  ILITE(I)=IQ 
      JOUT=IASC(I)
      GO TO 5036
C 
C  USER WANTS A SPECIFIC LIGHT #
C 
5016  IF(ILITE(JVAL).EQ.0) GO TO 5034 
      IF(IQ.LT.0) GO TO 5020
      N2=638+(IQ-1)*6 
      IF(ILITE(JVAL).LT.0) GO TO 5018 
      N1=638+(ILITE(JVAL)-1)*6
      IF(ISTAT.EQ.1) GO TO 5036 
      GO TO 5024
5018  N1=53+(-ILITE(JVAL)-1)*JWORDS 
      IF(ISTAT.EQ.1) GO TO 5036 
      GO TO 5024
5020  N2=53+(-IQ-1)*JWORDS
      IF(ILITE(JVAL).LT.0) GO TO 5022 
      N1=638+(ILITE(JVAL)-1)*6
      IF(ISTAT.EQ.1) GO TO 5036 
      GO TO 5024
5022  N1=53+(-ILITE(JVAL)-1)*JWORDS 
      IF(ISTAT.EQ.1) GO TO 5036 
5024  ISTAT=-2
      RETURN
5034  ILITE(JVAL)=IQ
5036  IF(IQ.GT.0) N1=3+(IQ-1)*JBYTES
      IF(IQ.LT.0) N1=101+(-IQ-1)*JBYTES 
      CALL MOVCA(JOUT,1,JFORM,N1,2) 
      ISTAT=0 
      RETURN
      END 
      END$
      