FTN4
      SUBROUTINE FILK(K,N,L,IP,IBUF,IFORM,NCHAR), 92080-1X318 REV.2026
     .  800515
C 
C     SOURCE 92080-18318
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*                                                                   *
C*               THIS SUBROUTINE IS USED TO INSERT THE 3070 SFK'S    *
C*  LABELS INTO THE IBUF BUFFER USEDFOR THE LINE PRINTOUT            *
C*                                                                   *
C*      PARAMETERS :                                                 *
C*            K IS   SFK #                                           *
C*            N IS CHAR OFFSET IN IBUF   N<0 MOVE USER TEXT          *
C*                                       N>0 MOVE SFK LABEL          *
C*            L IS STARTING CHAR IN LABEL                            *
C*              L=1 MEANS MOVE STARTING WITH 1ST CHAR                *
C*              L=2   "    "      "      "   2ND  "                  *
C*              L=M   "    "      "      "   MTH  "                  *
C*            IP = 0 NON PREFIXED KEY                                *
C*               = 1 PREFIXED KEY                                    *
C*            IBUF BUFFER USED  TO PRINT LABEL                       *
C*            IFORM BUFFER WHERE ARE STORED LABELS                   *
C*            NCHAR IS NO. OF CHAR TO MOVE                           *
C*                                                                   *
C*                                                                   *
C*********************************************************************
C 
      DIMENSION IBUF(1),IFORM(1),IPFIX(2) 
      DATA IPFIX/26,10/ 
      IGETB(IF)=IAND(IALF2(IGET1(IFORM,IF)),377B) 
      L1=L-1
      DO 100 I=1,IPFIX(IP+1)
      IOF=87+(858*IP)+(I-1)*33
      IK=0
      IM=1
      IN=IGETB(IOF+1) 
      IF(IN.EQ.40B) GO TO 110 
      IM=10 
      IK=IN-48
110   IN=IGETB(IOF) 
      IF(IN.EQ.40B) GO TO 120 
      IK=(IN-48)*IM+IK
120   IF(IK.NE.K) GO TO 100 
      IOF=IOF+L1
      IF(N.GT.0) CALL MOVCA(IFORM,IOF+21,IBUF,N,NCHAR)
      IF(N.LT.0) CALL MOVCA(IFORM,IOF+2,IBUF,-N,NCHAR)
      GO TO 200 
100   CONTINUE
200   RETURN
C 
5000  STOP 3354 
      END 
      END$
                                                                                            