FTN4,B,L
C 
      PROGRAM KEYS(3,75)
C 
C     DATE: 09 FEB 77 
C 
      DIMENSION IDCB(144),IBUF(40),IREG(2),LU(5)
      DIMENSION NWRDS(8),IBUF2(33),IBUF3(33)
      DIMENSION LABL1(13,4),LABL2(13,4) 
      DIMENSION ISTRG(45,8) 
C 
C DIMENSION TERMINAL INITIALIZATION AND LABEL DISPLAY RECORDS 
C 
      INTEGER REC1(4),REC2(55),REC3(55),REC4(2) 
C 
C DIMENSION SOFT KEY ASCII COMMAND STRING RECORD
C 
      INTEGER REC5(360),REC6(2) 
C 
C DIMENSION ASCII BUFFERS 
C 
      INTEGER REC7(53),REC8(51),REC9(72),REC10(35),REC11(72)
      INTEGER REC12(29),REC13(62),REC14(53),REC15(41),REC16(52) 
      INTEGER REC17(19),REC18(20),REC19(16),REC20(5),REC21(12)
C 
C EQUIVALENCES
C 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB),(KEYN,REC9(21))
      EQUIVALENCE (IERR,REC17(12))
C 
C LABEL EQUIVALENCES
C 
      EQUIVALENCE (LABL1(1,1),REC2(7)),(LABL2(1,1),REC3(7)) 
C 
C ASCII COMMAND STRING EQUIVALENCE
C 
      EQUIVALENCE (ISTRG(1,1),REC5(6))
C 
C DATA RECORD TO INITIALIZE THE TERMINAL
C 
      DATA REC1/015555B,015530B,015550B,015512B/
C 
C DATA RECORD TO DISPLAY THE FIRST FOUR SOFT KEY LABELS 
C 
      DATA REC2/020033B,023141B,030562B,033103B,015446B,062102B,
     1          020040B,020040B,020040B,020040B,020040B,020040B,
     2          020040B,020040B,015446B,062100B,015503B,015446B,
     3          062102B,020040B,020040B,020040B,020040B,020040B,
     4          020040B,020040B,020040B,015446B,062100B,015503B,
     5          015446B,062102B,020040B,020040B,020040B,020040B,
     6          020040B,020040B,020040B,020040B,015446B,062100B,
     7          015503B,015446B,062102B,020040B,020040B,020040B,
     8          020040B,020040B,020040B,020040B,020040B,015446B,
     9          062100B/
C 
C DATA RECORD TO DISPLAY THE SECOND FOUR SOFT KEY LABELS
C 
      DATA REC3/020033B,023141B,031562B,033103B,015446B,062102B,
     1          020040B,020040B,020040B,020040B,020040B,020040B,
     2          020040B,020040B,015446B,062100B,015503B,015446B,
     3          062102B,020040B,020040B,020040B,020040B,020040B,
     4          020040B,020040B,020040B,015446B,062100B,015503B,
     5          015446B,062102B,020040B,020040B,020040B,020040B,
     6          020040B,020040B,020040B,020040B,015446B,062100B,
     7          015503B,015446B,062102B,020040B,020040B,020040B,
     8          020040B,020040B,020040B,020040B,020040B,015446B,
     9          062100B/
C 
C DATA RECORD TO PROTECT SOFT KEY LABEL DISPLAY AND SET UP TERMINAL 
C 
      DATA REC4/015502B,015554B/
C 
C DATA RECORD CONTAINING COMMAND STRINGS FOR SOFT KEYS 1 THRU 8.
C 
C COMMAND STRING FOR SOFT KEY 1 
C 
      DATA REC5/015446B,063062B,060461B,065440B,031114B,015560B,
     1          39*020040B, 
C 
C COMMAND STRING FOR SOFT KEY 2 
C 
     2          015446B,063062B,060462B,065440B,031114B,015561B,
     3          39*020040B, 
C 
C COMMAND STRING FOR SOFT KEY 3 
C 
     4          015446B,063062B,060463B,065440B,031114B,015562B,
     5          39*020040B, 
C 
C COMMAND STRING FOR SOFT KEY 4 
C 
     6          015446B,063062B,060464B,065440B,031114B,015563B,
     7          39*020040B, 
C 
C COMMAND STRING FOR SOFT KEY 5 
C 
     8          015446B,063062B,060465B,065440B,031114B,015564B,
     9          39*020040B, 
C 
C COMMAND STRING FOR SOFT KEY 6 
C 
     A          015446B,063062B,060466B,065440B,031114B,015565B,
     B          39*020040B, 
C 
C COMMAND STRING FOR SOFT KEY 7 
C 
     C          015446B,063062B,060467B,065440B,031114B,015566B,
     D          39*020040B, 
C 
C COMMAND STRING FOR SOFT KEY 8 
C 
     E          015446B,063062B,060470B,065440B,031114B,015567B,
     F          39*020040B/ 
C 
C HOME THE CURSOR 
C 
      DATA REC6/015550B,015501B/
C 
C ASCII MESSAGE BUFFERS 
C 
      DATA REC7/006412B,2HEN,2HTE,2HR ,2HON,2HE ,2HOF,2H T,2HHE,2HSE, 
     C2H F,2HUN,2HCT,2HIO,2HNS,2H: ,2H[C,2HRE,2HAT,2HE,,2HMO,2HDI,2HFY, 
     C2H,O,2HUT,2HPU,2HT,,2HLI,2HST,2H] ,006412B,2HOR,2H P,2HRE,2HSS, 
     C2H [,2HRE,2HTU,2HRN,2H] ,2HTO,2H T,2HER,2HMI,2HNA,2HTE,2H T,
     C2HHI,2HS ,2HPR,2HOG,2HRA,2HM:/
C 
      DATA REC8/006412B,2HEN,2HTE,2HR ,2H[S,2HOF,2HT ,2HKE,2HY ,
     C2HNU,2HMB,2HER,2H (,2H1-,2H8),2H] ,2HTO,2H B,2HE ,2HPR,2HOG,
     C2HRA,2HMM,2HED,2H O,2HR ,006412B,2HPR,2HES,2HS ,2H[R,2HET,
     C2HUR,2HN],2H I,2HF ,2HLA,2HST,2H A,2HSS,2HIG,2HNM,2HEN,2HT ,
     C2HHA,2HS ,2HBE,2HEN,2H M,2HAD,2HE:/ 
C 
      DATA REC9/006412B,2H S,2HOF,2HT ,2HKE,2HY ,2HAS,2HSI,2HGN,
     C2HME,2HNT,2H F,2HOR,2H F,2HUN,2HCT,2HIO,2HN ,2HKE,2HY ,020040B, 
     C2*006412B,2HEN,2HTE,2HR ,2HUP,2H T,2HO ,2H[1,2H6 ,2HCH,2HAR,
     C2HAC,2HTE,2HRS,2H] ,2HFO,2HR ,2HSO,2HFT,2H K,2HEY,2H L,2HAB,
     C2HEL,2H O,2HR ,006412B,2HPR,2HES,2HS ,2H[R,2HET,2HUR,2HN],2H I, 
     C2HF ,2HNO,2H L,2HAB,2HEL,2H I,2HS ,2HTO,2H B,2HE ,2HAS,2HSI,
     C2HGN,2HED,2H: / 
C 
      DATA REC10/06412B,2HEN,2HTE,2HR ,2H[0,2H] ,2HFO,2HR ,2HNO,
     C2HRM,2HAL,2H O,2HR ,2H[2,2H] ,2HFO,2HR ,2HTR,2HAN,2HSM,2HIT,
     C2H O,2HNL,2HY ,006412B,2HCO,2HMM,2HAN,2HD ,2HST,2HRI,2HNG,
     C2H T,2HYP,2HE:/ 
C 
      DATA REC11/006412B,2HEN,2HTE,2HR ,2H[U,2HP ,2HTO,2H 8,2H0 , 
     C2HCH,2HAR,2HAC,2HTE,2HRS,2H] ,2HFO,2HR ,2HSO,2HFT,2H K,2HEY,
     C2H C,2HOM,2HMA,2HND,006412B,2HST,2HRI,2HNG,2H T,2HO ,2HBE,
     C2H A,2HSS,2HIG,2HNE,2HD ,2HTO,2H T,2HHI,2HS ,2HKE,2HY ,2HOR,
     C2H P,2HRE,2HSS,2H [,2HRE,2HTU,2HRN,2H] ,006412B,2HTO,2H D,
     C2HEF,2HAU,2HLT,2H T,2HO ,2HST,2HAN,2HDA,2HRD,2H C,2HOM,2HMA,
     C2HND,2H S,2HTR,2HIN,2HG:/ 
C 
      DATA REC12/006412B,2HEN,2HTE,2HR ,2H[F,2HIL,2HE ,2HNA,2HME, 
     C2H,S,2HEC,2HUR,2HIT,2HY ,2HCO,2HDE,2H,C,2HAR,2HTR,2HID,2HGE,
     C2H] ,2HOR,2H [,2H26,2H45,2HA ,2HLU,2H] /
C 
      DATA REC13/2HWH,2HER,2HE ,2HSO,2HFT,2H K,2HEY,2H C,2HOM,2HMA, 
     C2HND,2H S,2HET,2H T,2HO ,2HBE,2H M,2HOD,2HIF,2HIE,2HD ,2HIS,
     C2H S,2HTO,2HRE,2HD ,2HOR,006412B,2HPR,2HES,2HS ,2H[R,2HET,
     C2HUR,2HN],2H T,2HO ,2HCO,2HNT,2HIN,2HUE,2H M,2HOD,2HIF,2HYI,
     C2HNG,2H A,2H C,2HOM,2HMA,2HND,2H S,2HET,2H I,2HN ,2HTH,2HIS,
     C2H P,2HRO,2HGR,2HAM,2H: / 
C 
      DATA REC14/2HWH,2HER,2HE ,2HSO,2HFT,2H K,2HEY,2H C,2HOM,2HMA, 
     C2HND,2H S,2HET,2H T,2HO ,2HBE,2H O,2HUT,2HPU,2HT ,2HIS, 
     C2H S,2HTO,2HRE,2HD ,2HOR,006412B,2HPR,2HES,2HS ,2H[R,2HET,
     C2HUR,2HN],2H T,2HO ,2HOU,2HTP,2HUT,2H D,2HIR,2HEC,2HTL,2HY ,
     C2HFR,2HOM,2H T,2HHI,2HS ,2HPR,2HOG,2HRA,2HM:/ 
C 
      DATA REC15/2HTO,2H W,2HHI,2HCH,2H C,2HOM,2HMA,2HND,2H S,2HET, 
     C2H I,2HS ,2HTO,2H B,2HE ,2HOU,2HTP,2HUT,2H O,2HR ,2H[R,2HET,
     C2HUR,2HN],2H T,2HO ,006412B,2HRE,2HPL,2HAC,2HE ,2HOR,2HIG,
     C2HIN,2HAL,2H F,2HIL,2HE ,2HOR,2H L,2HU:/
C 
      DATA REC16/2HWH,2HER,2HE ,2HSO,2HFT,2H K,2HEY,2H C,2HOM,2HMA, 
     C2HND,2H S,2HET,2H T,2HO ,2HBE,2H L,2HIS,2HTE,2HD ,2HIS,2H S,
     C2HTO,2HRE,2HD ,2HOR,006412B,2HPR,2HES,2HS ,2H[R,2HET,2HUR,
     C2HN],2H T,2HO ,2HLI,2HST,2H D,2HIR,2HEC,2HTL,2HY ,2HFR,2HOM,
     C2H T,2HHI,2HS ,2HPR,2HOG,2HRA,2HM:/ 
C 
      DATA REC17/006412B,2HFI,2HLE,2H M,2HAN,2HAG,2HER,2H E,
     C2HRR,2HOR,020055B,020040B,2H H,2HAS,2H O,2HCC,2HUR, 
     C2HRE,2HD /
C 
      DATA REC18/006412B,2HER,2HRO,2HR ,2HIN,2H R,2HEA,2HDI,2HNG, 
     C2H C,2HOM,2HMA,2HND,2H S,2HET,2H F,2HRO,2HM ,2HLU,2H! / 
C 
      DATA REC19/006412B,2HNO,2H O,2HRI,2HGI,2HNA,2HL ,2HFI,
     C2HLE,2H O,2HR ,2HLU,2H E,2HXI,2HST,2HS:/
C 
      DATA REC20/006412B,2HEN,2HD ,2HKE,2HYS/ 
C 
      DATA REC21/006412B,2HKE,2HYS,2H H,2HAS,2H B,2HEE,2HN ,
     C2HAB,2HOR,2HTE,2HD!/
C 
C 
C RETRIEVE LU NUMBER OF 2645A INPUT TERMINAL-ILU
C RETRIEVE LU NUMBER OF LIST DEVICE-LU(2) 
C 
      CALL RMPAR(LU)
      IF((LU.LT.1).OR.(LU.GT.63))LU=1 
      ILU=IOR(LU,400B)
C 
      IF((LU(2).LT.1).OR.(LU(2).GT.63))LU(2)=ILU
      LU(2)=IOR(LU(2),200B) 
C 
C GO INITIALIZE ALL BUFFERS 
C 
      GOTO 700
    5 ICR=0 
      IMOD=0
      IOUT=0
      ILST=0
C 
C 
C CREATE, MODIFY, OUTPUT OR LIST A SOFT KEY COMMAND SET?
C 
   10 CALL EXEC(2,ILU,REC7,53)
      REG=EXEC(1,ILU,IBUF,1)
      IF(IBUF.EQ.040440B)GOTO 3000
      IF(IB.EQ.0)GOTO 2000
      IBUF=IAND(IBUF,077400B) 
      IF(IBUF.EQ.041400B)GOTO 200 
      IF(IBUF.EQ.046400B)GOTO 300 
      IF(IBUF.EQ.047400B)GOTO 400 
      IF(IBUF.EQ.046000B)GOTO 500 
      GOTO 10 
C 
C READ COMMAND SET FROM OLD FILE
C 
C 
C OPEN OLD FILE 
C 
   17 CALL OPEN(IDCB,IERR,IBUF2(2),0,IBUF2(6),IBUF2(10))
      IF(IERR.LT.0)GOTO 630 
C 
C READ CONTENTS OF FILE 
C 
      CALL READF(IDCB,IERR,REC1,4)
      IF(IERR.LT.0)GOTO 630 
C 
      CALL READF(IDCB,IERR,REC2,55) 
      IF(IERR.LT.0)GOTO 630 
C 
      CALL READF(IDCB,IERR,REC3,55) 
      IF(IERR.LT.0)GOTO 630 
C 
      CALL READF(IDCB,IERR,REC4,2)
      IF(IERR.LT.0)GOTO 630 
C 
      K=1 
      DO 20 I=1,8 
      CALL READF(IDCB,IERR,REC5(K),45,LEN)
      IF(IERR.LT.0)GOTO 630 
      NWRDS(I)=LEN
      K=K+45
   20 CONTINUE
C 
      CALL READF(IDCB,IERR,REC6,2)
      IF(IERR.LT.0)GOTO 630 
C 
C CLOSE FILE
C 
      CALL CLOSE(IDCB,IERR) 
      IF(IERR.LT.0)GOTO 630 
      IF(IMOD.EQ.1)GOTO 315 
      IF(IOUT.EQ.1)GOTO 415 
      IF(ILST.EQ.1)GOTO 510 
C 
C READ OLD COMMAND SET FROM A DEVICE LU 
C 
   22 REG=EXEC(1,IBUF2(2),REC1,4) 
      IF(IB.NE.4)GOTO 675 
C 
      REG=EXEC(1,IBUF2(2),REC2,55)
      IF(IB.NE.55)GOTO 675
C 
      REG=EXEC(1,IBUF2(2),REC3,55)
      IF(IB.NE.55)GOTO 675
C 
      REG=EXEC(1,IBUF2(2),REC4,2) 
      IF(IB.NE.2)GOTO 675 
C 
      K=1 
      DO 25 I=1,8 
      REG=EXEC(1,IBUF2(2),REC5(K),45) 
      NWRDS(I)=IB 
      K=K+45
   25 CONTINUE
C 
      REG=EXEC(1,IBUF2(2),REC6,2) 
      IF(IB.NE.2)GOTO 675 
      IF(IMOD.EQ.1)GOTO 315 
      IF(IOUT.EQ.1)GOTO 415 
      IF(ILST.EQ.1)GOTO 510 
C 
C 
C MAKE SOFT KEY ASSIGNMENTS 
C 
C 
C REQUEST FUNCTION KEY NUMBER WHOSE ASSIGNMENT IS TO BE MADE. 
C 
   30 CALL EXEC(2,ILU,REC8,51)
      REG=EXEC(1,ILU,KEYN,1)
      IF(IB.EQ.0)GOTO 10
      IF(KEYN.EQ.040440B)GOTO 3000
      IMSK1=IAND(KEYN,177B) 
      IF(IMSK1.NE.40B)GOTO 30 
      IMSK2=IAND(KEYN,077400B)
      IF((IMSK2.GT.034000B).OR.(IMSK2.LT.030400B))GOTO 30 
      KEY=KEYN/400B-60B 
C 
C READ SOFT KEY LABEL ASSIGNMENT OF UP TO 16 CHARACTERS AND STORE.
C 
      CALL EXEC(2,ILU,REC9,72)
C 
      REG=EXEC(1,ILU,IBUF,8)
      IF(IBUF.EQ.040440B)GOTO 3000
      IF(IB.EQ.0)GOTO 45
C 
C CENTER THE SOFT KEY LABEL IN THE LABEL FIELD. 
C 
      NUM=IAND(IB,1)
      IF(NUM.NE.0)GOTO 35 
      I1=IB 
      GOTO 40 
   35 I1=IB+1 
   40 L=((8-I1)/2)+1
C 
C INITIALIZE LABEL BUFFER FOR SPECIFIC KEY
C 
   45 IF(KEY.GT.4)KEY1=KEY-4
      DO 55 J=1,8 
      IF(KEY.GT.4)GOTO 50 
      LABL1(J,KEY)=020040B
      GOTO 55 
   50 LABL2(J,KEY1)=020040B 
   55 CONTINUE
      IF(IB.EQ.0)GOTO 85
C 
C SAVE THE SOFT KEY LABEL 
C 
   65 DO 80 K=1,IB
      IF(KEY.GT.4)GOTO 70 
      LABL1(L,KEY)=IBUF(K)
      GOTO 75 
   70 LABL2(L,KEY1)=IBUF(K) 
   75 L=L+1 
   80 CONTINUE
C 
C REQUEST SOFT KEY TYPE 
C 
   85 CALL EXEC(2,ILU,REC10,35) 
C 
      REG=EXEC(1,ILU,IBUF,1)
      IF(IBUF.EQ.040440B)GOTO 3000
      IF(IB.NE.0)GOTO 90
      ITYPE=62B 
      GOTO 95 
   90 ITYPE=IAND(IBUF,177B) 
      IF(ITYPE.NE.40B)GOTO 85 
      ITYPE=IAND(IBUF,077400B)
      IF((ITYPE.NE.030000B).AND.(ITYPE.NE.031000B))GOTO 85
      ITYPE=ITYPE/400B
C 
C SAVE THE SOFT KEY TYPE
C 
   95 REC5(45*(KEY-1)+2)=IOR(ITYPE,063000B) 
C 
C 
C REQUEST ASCII COMMAND STRING
C 
C 
  100 CALL EXEC(2,ILU,REC11,72) 
C 
      REG=EXEC(1,ILU,IBUF,-80)
      IF(IBUF.EQ.040440B)GOTO 3000
      IF(IB.NE.0)GOTO 105 
      NWRDS(KEY)=6
      L=45*(KEY-1)
      REC5(L+4)=065440B 
      REC5(L+5)=031114B 
      REC5(L+6)=015560B+(KEY-1) 
      GOTO 180
  105 IC=IB 
C 
C CONVERT NUMBER OF CHARACTERS TO ASCII EQUIVALENT
C 
  115 NCHAR=KCVT(IC)
C 
C CALCULATE WHERE TO STORE COMMAND STRING LENGTH IN REC5
C 
      LOC=((KEY-1)*45)+4
C 
C 
      IF(IC.GE.10)GOTO 165
C 
C NUMBER OF CHARACTERS IN COMMAND STRING IS LESS THAN 10. 
C 
C MASK SINGLE DIGIT,OR WITH ASCII L, SHIFT TO UPPER BYTE, OR
C WITH ASCII L, STORE IN WORD FIVE OF COMMAND STRING. 
C SET WORD FOUR OF ASCII COMMAND STRING TO 065440B. 
C 
      ICHR1=IAND(NCHAR,77B)*400B
      REC5(LOC)=065440B 
      REC5(LOC+1)=IOR(ICHR1,114B) 
      GOTO 170
C 
C NUMBER OF CHARACTERS IN COMMAND STRING IS GE 10.
C 
C MASK UPPER BYTE, SHIFT TO LOWER BYTE, OR WITH ASCII SMALL 
C K AND STORE IN WORD FOUR OF COMMAND STRING. 
C 
  165 ICHR1=IAND(NCHAR,037400B)/400B
      REC5(LOC)=IOR(065400B,ICHR1)
C 
C MASK LOWER BYTE, MOVE TO UPPER BYTE, OR WITH ASCII L AND
C STORE IN WORD FIVE OF COMMAND STRING. 
C 
      ICHR2=IAND(NCHAR,77B)*400B
      REC5(LOC+1)=IOR(ICHR2,114B) 
C 
C CALCULATE NUMBER OF WORDS IN COMMAND STRING 
C 
  170 NUM=IAND(IB,1)
      IF(NUM.NE.0)GOTO 175
      I1=IB/2 
      GOTO 180
  175 I1=(IB+1)/2 
C 
C INITIALIZE COMMAND STRING BUFFER FOR SPECIFIC KEY 
C 
  180 DO 185 I=2,40 
      ISTRG(I,KEY)=020040B
  185 CONTINUE
      IF(IB.EQ.0)GOTO 30
C 
C SAVE COMMAND STRING 
C 
      DO 190 I=1,I1 
      ISTRG(I,KEY)=IBUF(I)
  190 CONTINUE
C 
C SAVE NUMBER OF WORDS IN THE STRING
C 
      NWRDS(KEY)=5+I1 
      GOTO 30 
C 
C 
C CREATE A NEW SOFT KEYS COMMAND SET
C 
C 
  200 ICR=1 
      GOTO 700
  205 ICR=0 
      GOTO 30 
C 
C 
C MODIFY AN OLD COMMAND SET 
C 
C 
  300 IMOD=1
      CALL EXEC(2,ILU,REC12,29) 
      CALL EXEC(2,ILU,REC13,62) 
C 
      REG=EXEC(1,ILU,IBUF,-20)
      CALL PARSE(IBUF,IB,IBUF3) 
      IF(IBUF3(2).EQ.040440B)GOTO 3000
      IF(IBUF3.EQ.0)GOTO 315
      IBUF2=IBUF3 
      IBUF2(2)=IBUF3(2) 
      IBUF2(3)=IBUF3(3) 
      IBUF2(4)=IBUF3(4) 
      IBUF2(6)=IBUF3(6) 
      IBUF2(10)=IBUF3(10) 
      GOTO 700
  305 IF(IBUF2.EQ.1)GOTO 310
      GOTO 17 
  310 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 300 
      GOTO 22 
  315 IMOD=0
      GOTO 30 
C 
C OUTPUT COMMAND SET
C 
  400 IOUT=1
C 
C REQUEST WHERE COMMAND SET TO BE OUTPUT IS STORED [FILE,LU OR KEYS]
C 
      CALL EXEC(2,ILU,REC12,29) 
      CALL EXEC(2,ILU,REC14,53) 
C 
      REG=EXEC(1,ILU,IBUF,-20)
      CALL PARSE(IBUF,IB,IBUF3) 
      IF(IBUF3(2).EQ.040440B)GOTO 3000
      IF(IBUF3.EQ.0)GOTO 415
      IBUF2=IBUF3 
      IBUF2(2)=IBUF3(2) 
      IBUF2(3)=IBUF3(3) 
      IBUF2(4)=IBUF3(4) 
      IBUF2(6)=IBUF3(6) 
      IBUF2(10)=IBUF3(10) 
      IF(IBUF2.EQ.1)GOTO 405
      GOTO 17 
  405 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 400 
      GOTO 22 
C 
C REQUEST [FILE,LU] WHERE COMMAND SET IS TO BE OUTPUT 
C 
  415 IOUT=0
      IFLG=0
      CALL EXEC(2,ILU,REC12,29) 
      CALL EXEC(2,ILU,REC15,41) 
C 
      REG=EXEC(1,ILU,IBUF,-20)
      CALL PARSE(IBUF,IB,IBUF3) 
      IF(IBUF3(2).EQ.040440B)GOTO 3000
C 
C COMMAND SET TO BE OUTPUT TO A FILE OR LU? 
C 
      IF(IBUF3.EQ.0)GOTO 420
      IF(IBUF3.EQ.1)GOTO 430
      GOTO 600
  420 IF(IBUF2.EQ.0)GOTO 1000 
      IF(IBUF2.EQ.1)GOTO 425
      GOTO 610
  425 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 415 
      GOTO 665
  430 IF((IBUF3(2).LT.1).OR.(IBUF3(2).GT.63))GOTO 415 
      GOTO 660
C 
C LIST COMMAND SET
C 
  500 ILST=1
      CALL EXEC(2,ILU,REC12,29) 
      CALL EXEC(2,ILU,REC16,52) 
C 
      REG=EXEC(1,ILU,IBUF,-20)
      CALL PARSE(IBUF,IB,IBUF3) 
      IF(IBUF3(2).EQ.040440B)GOTO 3000
      IF(IBUF3.EQ.0)GOTO 510
      IBUF2=IBUF3 
      IBUF2(2)=IBUF3(2) 
      IBUF2(3)=IBUF3(3) 
      IBUF2(4)=IBUF3(4) 
      IBUF2(6)=IBUF3(6) 
      IBUF2(10)=IBUF3(10) 
      IF(IBUF2.EQ.1)GOTO 505
      GOTO 17 
  505 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 500 
      GOTO 22 
C 
C LIST SOFT KEY COMMAND SET 
C 
  510 ILST=0
      DO 515 K=1,4
      REG=EXEC(2,LU(2),LABL1(1,K),8)
      ITYPE=IAND(REC5(2+45*(K-1)),77B)
      REG=EXEC(2,LU(2),ITYPE,1) 
      REG=EXEC(2,LU(2),ISTRG(1,K),NWRDS(K)) 
  515 CONTINUE
      DO 520 K=1,4
      REG=EXEC(2,LU(2),LABL2(1,K),8)
      ITYPE=IAND(REC5(2+45*(K+3)),77B)
      REG=EXEC(2,LU(2),ITYPE,1) 
      REG=EXEC(2,LU(2),ISTRG(1,K+4),NWRDS(K+4)) 
  520 CONTINUE
      GOTO 10 
C 
C COMMAND SET IS TO BE STORED IN A FILE 
C 
C 
  600 IBUF2=IBUF3 
      IBUF2(2)=IBUF3(2) 
      IBUF2(3)=IBUF3(3) 
      IBUF2(4)=IBUF3(4) 
      IBUF2(6)=IBUF3(6) 
      IBUF2(10)=IBUF3(10) 
      GOTO 615
C 
C CREATE OR REPLACE COMMAND SET FILE
C 
  610 CALL OPEN(IDCB,IERR,IBUF2(2),0,IBUF2(6),IBUF2(10))
      IF(IERR.LT.0)GOTO 630 
      GOTO 620
  615 CALL CREAT(IDCB,IERR,IBUF2(2),5,4,IBUF2(6),IBUF2(10)) 
      IF(IERR.LT.0)GOTO 630 
C 
C WRITE FIRST RECORD
C 
  620 CALL WRITF(IDCB,IERR,REC1,4)
      IF(IERR.LT.0)GOTO 630 
C 
C WRITE SECOND RECORD FOR FIRST FOUR SOFT KEY LABELS
C 
      CALL WRITF(IDCB,IERR,REC2,55) 
      IF(IERR.LT.0)GOTO 630 
C 
C WRITE THIRD RECORD FOR SECOND FOUR SOFT KEY LABELS
C 
      CALL WRITF(IDCB,IERR,REC3,55) 
      IF(IERR.LT.0)GOTO 630 
C 
C WRITE FOURTH RECORD 
C 
      CALL WRITF(IDCB,IERR,REC4,2)
      IF(IERR.LT.0)GOTO 630 
C 
C WRITE SOFT KEY COMMAND STRINGS
C 
      K=1 
      DO 625 KEY=1,8
      CALL WRITF(IDCB,IERR,REC5(K),NWRDS(KEY))
      IF(IERR.LT.0)GOTO 630 
      K=K+45
  625 CONTINUE
C 
C WRITE SIXTH RECORD
C 
      CALL WRITF(IDCB,IERR,REC6,2)
      IF(IERR.LT.0)GOTO 630 
C 
C WRITE AN END OF FILE
C 
      CALL WRITF(IDCB,IERR,REC6,-1) 
      IF(IERR.LT.0)GOTO 630 
      GOTO 650
C 
C FILE MANAGER ERROR MESSAGE
C 
C CONVERT TWO'S COMPLEMENT OF FMGR ERROR CODE TO POSITIVE 
C OCTAL EQUIVALENT
C 
  630 IFLG=1
      IERR1=IERR-1B 
      IB=1
      DO 645 I=1,16 
      IE=IAND(IERR1,IB) 
      IF(IE.EQ.IB)GOTO 635
      IERR1=IERR1+IB
      GOTO 640
  635 IERR1=IERR1-IB
  640 IB=IB*2B
  645 CONTINUE
C 
C CONVERT OCTAL ERROR CODE TO ASCII EQUIVALENT
C 
      IERR=KCVT(IERR1)
C 
C WRITE ERROR MESSAGE 
C 
      CALL EXEC(2,ILU,REC17,19) 
C 
C CLOSE FILE
C 
  650 CALL CLOSE(IDCB,IERR) 
      IF(IMOD.EQ.1)GOTO 300 
      IF(IOUT.EQ.1)GOTO 400 
      IF(ILST.EQ.1)GOTO 500 
      IF(IFLG.EQ.1)GOTO 415 
      GOTO 10 
C 
C 
C COMMAND SET TO BE OUTPUT TO A DEVICE LOGICAL UNIT 
C 
  660 IBUF2=IBUF3 
      IBUF2(2)=IBUF3(2) 
C 
C WRITE FIRST RECORD TO LU
C 
  665 REG=EXEC(2,IBUF2(2),REC1,4) 
C 
C WRITE SECOND RECORD TO LU 
C 
      REG=EXEC(2,IBUF2(2),REC2,55)
C 
C WRITE THIRD RECORD TO LU
C 
      REG=EXEC(2,IBUF2(2),REC3,55)
C 
C WRITE FOURTH RECORD TO LU 
C 
      REG=EXEC(2,IBUF2(2),REC4,2) 
C 
C WRITE SOFT KEY COMMAND STRINGS
C 
      K=1 
      DO 670 KEY=1,8
      REG=EXEC(2,IBUF2(2),REC5(K),NWRDS(KEY)) 
      K=K+45
  670 CONTINUE
C 
C WRITE SIXTH RECORD TO LU
C 
      REG=EXEC(2,IBUF2(2),REC6,2) 
      GOTO 10 
C 
C EXEC ERROR MESSAGE
C 
  675 CALL EXEC(2,ILU,REC18,20) 
      IF(IMOD.EQ.1)GOTO 300 
      IF(IOUT.EQ.1)GOTO 400 
      IF(ILST.EQ.1)GOTO 500 
      GOTO 10 
C 
C INITIALIZE ALL BUFFERS
C 
  700 DO 710 K=1,4
      DO 710 J=1,8
      LABL1(J,K)=020040B
      LABL2(J,K)=020040B
  710 CONTINUE
      DO 715 K=1,8
      NWRDS(K)=6
      L=45*(K-1)
      REC5(L+2)=063062B 
      REC5(L+4)=065440B 
      REC5(L+5)=031114B 
      REC5(L+6)=015560B+(K-1) 
      DO 715 J=2,40 
      ISTRG(J,K)=020040B
  715 CONTINUE
      IF(ICR.EQ.1)GOTO 205
      IF(IMOD.EQ.1)GOTO 305 
      GOTO 5
C 
C NO ORIGINAL FILE OR LU EXISTS MESSAGE 
C 
 1000 CALL EXEC(2,ILU,REC19,16) 
      GOTO 415
C 
C END KEYS MESSAGE
C 
 2000 CALL EXEC(2,ILU,REC20,5)
      GOTO 4000 
C 
C KEYS HAS BEEN ABORTED MESSAGE 
C 
 3000 CALL EXEC(2,ILU,REC21,12) 
 4000 END 
      END$