*DECK C$SETKY 
          IDENT  C$SETKY
          TITLE  C$SETKY - SET ALTERNATE KEY POINTERS IN FIT
  
          MACHINE  ANY,I
          COMMENT  SET ALTERNATE KEY POINTERS IN FIT
          SST 
          B1=1
          SPACE  4
**        CBSETKY - SETS KEY POINTERS IN THE FIT
* 
*         CALLING SEQUENCE
* 
*         C.SETDS - SETS FILE STATUS TO 00 OR 02 AFTER READ 
*                EQ  =XC.SETDS
*            RETURNS TO PROGRAM 
* 
*         C.SETKY  -  SETS KEY TO B3 VALUE - SETS KEY OF REF
*                B3 = KEY NUMBER
*                RJ  =XC.SETKY
* 
*         C.SETKR  -  SETS KEY TO KEY OF REFERENCE
*                RJ  =XC.SETKR
* 
*         C.SETPK  -  SETS PRIME KEY AS KEY AND DOES NORMAL RETURN
*                EQ  =XC.SETPK
* 
*         DOES   SETS RKW, KA, KP, RKP, KL IN THE FIT 
*                C.SETKY ALSO SETS MIKR IN THE EXTENSION
* 
*         USES   MIAK AND MINF
*                CHANGES A4, A5, A6, X0, X4, X5, X6, X7 
*                ALL BUT C.SETKY CHANGE B3
* 
  
  
*CALL IOMICROS
  
*CALL IODEFSC 
          EJECT  C.SETDS
          ENTRY  C.SETDS
 C.SETDS  BSS    0           SETS FILE-STATUS TO 00 OR 02 FOR READS 
          SA2    KEYNBR      GET KEY ORDINAL OF LAST SETKY
          ZR     X2,=XC.NORRT  EOK NOT SET ON PRIME KEY - RETURN 00 
          FETCH  A0,FP,X5    GET FILE POSITION
          SX5    X5-#EOK# 
          ZR     X5,=XC.NORRT      RETURN 00  IF NEXT NOT A DUPLICATE 
          SX1    2R02        RETURN 02 TO FS IF DUPLICATES
          EQ     =XC.NORRX   GO STORE IT AND RETURN 
 C.SETKR  EJECT 
          ENTRY  C.SETKR
 C.SETKR  DATA   0           SETS KEY TO KEY OF REFERENCE 
          MX6    1
          SA6    RSTFLAG     SET FLAG TO NOT SET KEY OF REF 
          FETCH  A0,MIKR,X5  GET KEY OF REF 
          SB3    X5 
          RJ     C.SETKY     GO SET IT
          EQ     C.SETKR
 C.SETPK  SPACE  2
          ENTRY  C.SETPK
 C.SETPK  DATA   0           SET KEY TO PRIME KEY - DO NOT SET KEY OF RF
          MX6    1
          SB3    B0 
          SA6    RSTFLAG     SET FLAG FOR NOT SETTING KEY OF REF
          RJ     C.SETKY     GO SET PRIME KEY 
          EQ     C.SETPK
 C.SETKY  SPACE  2
          ENTRY  C.SETKY
 C.SETKY  DATA   0           SETS KEY TO B3 VALUE 
          SX7    B3 
          SA7    KEYNBR      SAVE KEY ORDINAL FOR SETDS 
          FETCH  A0,KEYT,X5  GET KEY TABLE
          SX5    X5+B3       DOUBLE ORDINAL BECUASE TABEL HAS 2 WDS/ENTR
          SA4    X5+B3       GET PROPER KEY ENTRY 
          FETCH  A0,RECA,X5 
          LX4    #KWNS#      POS WORD NUMBER
          MX7    60-#KWNS#
          BX7    -X7*X4      GETS WORD NBR OF KEY 
          IX5    X7+X5       WORD ADDR OF KEY 
          STORE  A0,KA=X5 
          STORE  A0,RKW=X4
          LX4    #KBCS# 
          STORE  A0,KP=X4 
          NZ     B3,SETK2    JP IF NOT PRIMARY KEY
          FETCH  A0,EMK,X5   GET EMBEDDED KEY FLAG
          NG     X5,SETK2    JP IF KEY IN RECORD
          FETCH  A0,PKA,X6   GET ACTUAL ADDRESS OF NON EMBEDDED KEY 
          STORE  A0,KA=X6    SET KA TO THIS ADDRESS 
          MX5    60-#KBCS#
          BX4    X5*X4
          SX5    10 
          BX4    X5+X4       CHANGE RKP TO 10 TO FLAG KEY NOT IN REC
 SETK2    BSS    0
          STORE  A0,RKP=X4   SET RECORD KEY POSITION
          LX4    #KKLS# 
          MX6    60-#KKLS#
          BX4    -X6*X4 
          NZ     B3,NTPK     JUMP IF NOT PRIME KEY
          FETCH  A0,FO,X5    GET FILE ORG 
          SX5    X5-#AK#
          NZ     X5,NTPK     JUMP IF NOT AN ACTUAL KEY FILE 
          FETCH  A0,ORG,X5   GET ORIGIN 
          PL     X5,SETK3    JP IF ORG=OLD - KL IN BITS 
          SA5    A4+B1       GET KEY WORD 2 
          LX5    59-#KCP4P#   POSITION COMP4 FLAG 
          NG     X5,NTPK     JP IF COMP-4 - KP AND RKP OK 
          SX5    10          KL IS IN CHARACTERS FOR ORG=NEW
          IX0    X5-X4       COMPUTE KP 
          STORE  A0,KP=X0 
          FETCH  A0,EMK,X5
          PL     X5,NTPK     JP IF NOT EMBEDDED KEY 
          STORE  A0,RKP=X0
          EQ     NTPK 
 SETK3    BSS    0
          SX5    6
          IX4    X5*X4       KL MUST BE IN BITS 
          SX5    X4-48
          NG     X5,NTPK     JP IF LENGTH OK
          SX4    47          MUST BE LESS THAN 48 BITS LONG 
 NTPK     BSS    0
          STORE  A0,KL=X4    SET KEY LENGTH 
          SA4    A4          KEY TABLE WORD AGAIN 
          LX4    #KWNS#+#KBCS#+#KKLS#+#KNIL1#+#KTYP#
          MX5    60-#KTYP#
          BX4    -X5*X4      KEY TYPE 
          STORE  A0,KT=X4 
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5 
          ZR     X5,SETKYEX  JUMP IF I/O NOT VIA CDCS 
          SA4    A4 
          MX7    60-#KROS#
          BX7    -X7*X4 
 CDCS1    IFEQ   OP.DCS,OP.DCS1 
          SA5    =XC.BINRY
          SX5    X5-5 
          NG     X5,OLDBIN   JP IF OLD BINARY - FIELDS ALREADY 10 BITS
          BX5    X7 
          AX7    2           CHANGE 12 BIT FIELDS TO 10 FOR CDCS1 
          MX6    60-10
          BX5    -X6*X5 
          BX7    X6*X7
          BX7    X7+X5
 OLDBIN   BSS    0
 CDCS1    ENDIF 
          SA7    =XC.KRORD   SET RECORD ORDINAL/KEY ORDINAL 
 SETKYEX  BSS    0
 CDCS     ENDIF 
          SA5    RSTFLAG
          MX6    0
          SA6    A5 
          NZ     X5,C.SETKY  EXIT IF KEY OF REF NOT TO BE SET 
          STORE  A0,MIKR=B3  SET KEY OF REF 
          EQ     C.SETKY
 RSTFLAG  DATA   0
 KEYNBR   DATA   0
          END 
