FTN4,B,L
C 
      PROGRAM KYDMP(3,10) 
C 
C     DATE:09 FEB 77
C 
C 
C     KYDMP IS A PROGRAM THAT WILL OUTPUT SOFT KEY COMMAND SETS 
C     FROM DISC OR MINI CARTRIDGE FILE OR LU TO A 2645A TERMINAL
C     IN AN HP 1000 SYSTEM. IT IS PROVIDED SPECIFICALLY FOR RTE-M 
C     SYSTEMS IN WHICH THERE IS NO FMGR PROGRAM.
C 
C     USE ONE OF THE FOLLOWING COMMAND SEQUENCES TO RUN KYDMP 
C     FROM RTE OR FMGR: 
C 
C        1) TO DUMP A COMMAND SET FROM A DISC OR MINI-CARTRIDGE 
C           FILE USE: 
C 
C                RU,KYDMP,[LU],FI,[LN],[AM] [,SECURITY CODE]
C 
C        2) TO DUMP A COMMAND SET FROM AN UNNAMED MINI-CARTRIDGE
C           FILE USE: 
C 
C                RU,KYDMP,[LU],CTU
C 
C                WHERE: [LU] = THE LU# OF THE 2645A TERMINAL TO WHICH 
C                              THE COMMAND SET IS TO BE OUTPUT.DEFAULT
C                              IS LU 1. 
C 
C                       FI,LN,AM =FILE NAME WHERE COMMAND SET IS STORED 
C                              FI = FIRST TWO CHARACTERS OF ASCII NAME
C                              LN = SECOND TWO CHARACTERS OF ASCII NAME 
C                              AM = THIRD TWO CHARACTERS OF ASCII NAME
C 
C                       SECURITY CODE = SECURITY CODE OF FILE (OPTIONAL)
C 
C                       CTU = LU# OF 2645A CTU WHERE COMMAND SET TO BE
C                              DUMPED IS STORED.
C 
C 
      DIMENSION IDCB(144),IP(5),NAM(3),IBUF(55) 
      DIMENSION MSG1(22),MSG2(20),MSG3(17),IA(2)
C 
      EQUIVALENCE (IP(2),NAM),(REG,IA),(IB,IA(2)),(IERR,MSG2(8))
C 
      DATA MSG1/006412B,2HNO,2H S,2HEC,2HON,2HD ,2HPA,2HRA,2HME,
     C2HTE,2HR ,2HSP,2HEC,2HIF,2HIE,2HD ,2HOR,2H N,2HEG,2HAT, 
     C2HIV,2HE /
C 
C 
      DATA MSG2/006412B,2HFM,2HGR,2H E,2HRR,2HOR,020055B,020040B, 
     C2H W,2HHE,2HN ,2HRE,2HAD,2HIN,2HG ,2HFR,2HOM,2H F,2HIL,2HE /
C 
      DATA MSG3/006412B,2HER,2HRO,2HR ,2HIN,2H R,2HEA,2HDI,2HNG,
     C2H F,2HRO,2HM ,2H26,2H45,2HA ,2HCT,2HU /
C 
C 
C RETRIEVE PARAMETERS 
C 
      CALL RMPAR(IP)
      IF((IP.LT.1).OR.(IP.GT.77B))IP=1
C 
C IS SECOND PARAMETER AN LU?
C 
      IF(IP(2).LT.1)GOTO 300
      IF(IP(2).LT.77B)GOTO 200
C 
C SECOND PARAMETER IS A FILE NAME 
C 
      IF(IP(3).EQ.0)IP(3)=020040B 
      IF(IP(4).EQ.0)IP(4)=020040B 
C 
C READ COMMAND SET FROM A FILE AND OUTPUT TO 2645A
C 
C OPEN FILE 
C 
      CALL OPEN(IDCB,IERR,NAM,0,IP(5))
      IF(IERR.LT.0)GOTO 310 
C 
C READ FIRST RECORD AND OUTPUT
C 
      CALL READF(IDCB,IERR,IBUF,4)
      IF(IERR.LT.0)GOTO 310 
      REG=EXEC(2,IP,IBUF,4) 
C 
C READ SECOND RECORD AND OUTPUT 
C 
      CALL READF(IDCB,IERR,IBUF,55) 
      IF(IERR.LT.0)GOTO 310 
      REG=EXEC(2,IP,IBUF,55)
C 
C READ THIRD RECORD AND OUTPUT
C 
      CALL READF(IDCB,IERR,IBUF,55) 
      IF(IERR.LT.0)GOTO 310 
      REG=EXEC(2,IP,IBUF,55)
C 
C READ FOURTH RECORD AND OUTPUT 
C 
      CALL READF(IDCB,IERR,IBUF,2)
      IF(IERR.LT.0)GOTO 310 
      REG=EXEC(2,IP,IBUF,2) 
C 
C READ EIGHT COMMAND STRING RECORDS AND OUTPUT
C 
      DO 110 I=1,8
      CALL READF(IDCB,IERR,IBUF,45,LEN) 
      IF(IERR.LT.0)GOTO 310 
      REG=EXEC(2,IP,IBUF,LEN) 
  110 CONTINUE
C 
C READ LAST RECORD AND OUTPUT 
C 
      CALL READF(IDCB,IERR,IBUF,2)
      IF(IERR.LT.0)GOTO 310 
      REG=EXEC(2,IP,IBUF,2) 
C 
C CLOSE FILE
C 
      CALL CLOSE(IDCB,IERR) 
      GOTO 400
C 
C 
C READ COMAND SET FROM LU 
C 
C READ FIRST RECORD FROM 2645A CTU AND OUTPUT 
C 
  200 REG=EXEC(1,NAM,IBUF,4)
      IF(IB.NE.4)GOTO 330 
      REG=EXEC(2,IP,IBUF,4) 
C 
C READ SECOND RECORD FROM 2645A CTU AND OUTPUT
C 
      REG=EXEC(1,NAM,IBUF,55) 
      IF(IB.NE.55)GOTO 330
      REG=EXEC(2,IP,IBUF,55)
C 
C READ THIRD RECORD FROM 2645A CTU AND OUTPUT 
C 
      REG=EXEC(1,NAM,IBUF,55) 
      IF(IB.NE.55)GOTO 330
      REG=EXEC(2,IP,IBUF,55)
C 
C READ FOURTH RECORD FROM 2645ACTU AND OUTPUT 
C 
      REG=EXEC(1,NAM,IBUF,2)
      IF(IB.NE.2)GOTO 330 
      REG=EXEC(2,IP,IBUF,2) 
C 
C READ EIGHT COMMAND STRING RECORDS AND OUTPUT
C 
      DO 210 I=1,8
      REG=EXEC(1,NAM,IBUF,45) 
      REG=EXEC(2,IP,IBUF,IB)
  210 CONTINUE
C 
C READ LAST RECORD FROM 2645A CTU AND OUTPUT
C 
      REG=EXEC(1,NAM,IBUF,2)
      IF(IB.NE.2)GOTO 330 
      REG=EXEC(2,IP,IBUF,2) 
      GOTO 400
C 
C MESSAGE-SECOND PARAMETER ZERO OR NEGATIVE 
C 
  300 CALL EXEC(2,IP,MSG1,22) 
      GOTO 400
C 
C MESSAGE-ERROR WHEN READING FROM FILE
C 
  310 IERR1=IERR-1B 
      IB=1
      DO 320 I=1,16 
      IE=IAND(IERR1,IB) 
      IF(IE.EQ.IB)GOTO 312
      IERR1=IERR1+IB
      GOTO 315
  312 IERR1=IERR1-IB
  315 IB=IB*2B
  320 CONTINUE
      IERR=KCVT(IERR1)
      CALL EXEC(2,IP,MSG2,20) 
      GOTO 400
C 
C ERROR WHEN READING FROM 2645A CTU 
C 
  330 CALL EXEC(2,IP,MSG3,17) 
  400 END 
      END$