*DECK KDEFDMP                                                            KDEFDMP
*CALL COMUSETXT 
USETEXT AAMMIPB ; 
PROC KDEF$MP( N ) ;                                                      AM2A077
 #                                                                       AM2A077
* *   KDEF$MP - WRITE LEVEL 1 OF THE MIP FILE                            AM2A077
*                                                                        AM2A077
* DC  FUNCTION                                                           AM2A077
*                                                                        AM2A077
*     WRITES LEVEL 1 (ALTERNATE KEY DEFS) OF THE MIP FILE.               AM2A077
*                                                                        AM2A077
* DC  ENTRY CONDITIONS                                                   AM2A077
*                                                                        AM2A077
*     THERE IS ONE PARAMETER PASSED IN THE USUAL SYMPL WAY.  IT IS THE   AM2A077
*     ADDRESS OF THE KEY DEFINITION.                                     AM2A077
*                                                                        AM2A077
*     P<FIT$AA> MUST BE THE ADDRESS OF THE CURRENT FIT.                  AM2A077
*                                                                        AM2A077
* DC  ERROR CONDITIONS                                                   AM2A077
*                                                                        AM2A077
*     EC206 - KEY NOT WITHIN RECORD.                                     AM2A077
*     EC540 - FIFO NOT ALLOWED IN REPEATING GROUP.                       AM2A077
*     EC541 - PURGE IS ILLEGAL IF KEY IS NOT KNOWN.                      AM2A077
*     EC542 - CANNOT ADD KEYDEF, IT ALREADY EXISTS.                      AM2A077
*     EC505 - ERROR IN RMKDEF PARAMETER.                                 AM2A077
*     EC527 - REDEFINITION OF SCC IS ILLEGAL.                            AM2A077
*                                                                        AM2A077
* DC  EXIT CONDITIONS                                                    AM2A077
*                                                                        AM2A077
*     WRITES OR UPDATES LEVEL 1 OF THE MIP FILE.                         AM2A077
*                                                                        AM2A077
*     IF SCC DEFINITION, SCC DESCRIPTORS ARE SET IN THE FSTT.            AM2A077
*                                                                        AM2A077
*     THE FSTT MAXIMUM ALT KEY FIELD HAS BEEN UPDATED.                   AM2A077
*                                                                        AM2A077
*     THE FSTT KEY SUBSTRUCTURE TYPE COUNTS ARE UPDATED.                 AM2A077
*                                                                        AM2A077
* DC  CALLED ROUTINES                                                    AM2A077
*                                                                        AM2A077
*     STMD$AA - INITIALIZES ON THE MIP FILE.                             AM2A077
*     KRAK$MP - CRACKS THE ALTERNATE KEY DEF.                            AM2A077
*     WKKY$IS - LOCATES A RECORD BY KEY.                                 AM2A077
*     CURR$AA - LOCATES CURRENT BLOCK AND RECORD INDICATED BY CURPTR.    AM2A077
*     SEBL$AA - LOCATES BLOCK NAMED IN PTREE.                            AM2A077
*     LOCR$AA - LOCATES RECORD BY NUMBER IN THE CURRENT BLOCK.           AM2A077
*     FIXX$AA - REMOVES A BLOCK TEMPORARILY FROM THE KO CHAIN.           AM2A077
*     LOCB$AA - LOCATES A BLOCK BY PRU NUMBER.                           AM2A077
*     UNFX$AA - RELEASES A FROZEN BLOCK TO THE KO CHAIN.                 AM2A077
*     MSGF$AA - OUTPUTS FATAL ERROR MESSAGES.                            AM2A077
*     PTRP$IS - INSERTS KEYDEF RECORD AT CURRENT POSITION.               AM2A077
*     NUSK$MP - ADDS SUBFILE HEADER TO LEVEL 1 RECORD.                   AM2A077
*     DLTE$IS - DELETES KEYDEF RECORD FROM FILE.                         AM2A077
*     CCAL$AA - ALIAS AWAYCHN, ENSURES RARE$IS IS LOADED AND TRANSFERS   AM2A077
*               THERE TO DELINK THE BLOCK CHAIN.                         AM2A077
*                                                                        AM2A077
* DC  DESCRIPTION                                                        AM2A077
*                                                                        AM2A077
*     IF FIRST KEYDEF DESCRIBES PRIMARY KEY, RETURN.                     AM2A077
*                                                                        AM2A077
*     TRANSFER TO STMD$AA TO SET FSTT, PTREE, AND FINF POINTERS, SET     AM2A077
*     KEY DESCRIPTOR VARIABLES, AND POSITION MIP FILE.                   AM2A077
*                                                                        AM2A077
*     TRANSFER TO KRAK$MP TO CRACK THE KEYDEF SET UP IN THE -MPAKD- WORD AM2A077
*     OF THE FIAAT.  SETS AKL, AKT, AKP, AKS, AND AKC.                   AM2A077
*                                                                        AM2A077
*     IF THIS KEYDEF IS A SCC DEFINITION THEN ERROR 527B IF SCC HAS      AM2A077
*     ALREADY BEEN DEFINED, ELSE SET SCC DESCRIPTORS IN THE FSTT AND     AM2A077
*     RETURN.                                                            AM2A077
*                                                                        AM2A077
*     FOR SIGNED KEY TYPE, ERROR 505 IF POSITION NOT 0 OR LENGTH NOT 10. AM2A077
*                                                                        AM2A077
*     CHECK THAT KEY DEF DEFINES A KEY CONTAINED IN THE SMALLEST RECORD  AM2A077
*     AND WITHIN THE LIMIT OF THE LARGEST RECORD - IF NOT, ERROR 206B.   AM2A077
*                                                                        AM2A077
*     ERROR 540B IF KEY DEF SPECIFIES FIFO KEY SUBSTRUCTURE AND A        AM2A077
*     REPEATING GROUP.                                                   AM2A077
*                                                                        AM2A077
*     TRANSFER TO WKKY$IS WHICH CALLS EZKY$IS TO TRY TO LOCATE THE       AM2A077
*     KEYDEF RECORD AND POSITION THE MIP FILE.                           AM2A077
*                                                                        AM2A077
*     IF NO MATCH ON THE KEYDEF RECORD:                                  AM2A077
*       -ERROR 541B IF KEYDEF IS TO BE PURGED.                           AM2A077
*       -INSERT KEYDEF RECORD.                                           AM2A077
*       -IN CASE THERE WAS A BLOCK SPLIT, TRANSFER TO CURR$AA TO LOCATE  AM2A077
*        THE CURRENT BLOCK AND RECORD AGAIN.                             AM2A077
*       -TRANSFER TO NUSK$MP TO ADD SUBFILE HEADER TO LEVEL 1 RECORD.    AM2A077
*       -IF AKL IS GREATER THAN THE MAXIMUM ALT KEY LENGTH, THEN RESET   AM2A077
*        THE FSTT MAXIMUM ALT KEY FIELD.                                 AM2A077
*                                                                        AM2A077
*     IF MATCH ON THE KEYDEF RECORD:                                     AM2A077
*       -ERROR 542B IF KEYDEF IS TO BE ADDED.                            AM2A077
*       -CHECK IF RECORD HAS SUBFILE.                                    AM2A077
*       -DELETE THE KEYDEF RECORD.                                       AM2A077
*       -IF KEYDEF HAD SUBFILE THEN FIND AND RELEASE ALL BLOCKS          AM2A077
*         WHICH CONTAIN THE LEVEL 2 AND LEVEL 3 RECORDS FROM THE CHAIN.  AM2A077
*                                                                        AM2A077
*     ADJUST THE KEY SUBSTRUCTURE TYPE COUNTS TO REFLECT THE INSERTION   AM2A077
*     OR DELETION. IF DELETION, AKS HAD TO BE RESET FROM THE
*     KEYDEF RECORD IN THE MIP FILE, AS THE RMKDEF STATEMENT
*     NEEDNT HAVE CONTAINED IT. 
*                                                                        AM2A077
 #                                                                       AM2A077
                                                                         AM2A077
      BEGIN                                                              AM2A077
                                                                         AM2A077
      XREF                                                               AM2A077
          BEGIN                                                          AM2A077
          PROC KRAK$MP ;                                                 KDEFDMP
          PROC CURR$AA ;                                                 KDEFDMP
          PROC PTRP$IS ;                                                 KDEFDMP
          PROC DLTE$IS ;                                                 KDEFDMP
          PROC WKKY$IS ;                                                 KDEFDMP
          PROC CCAL$AA ;                                                 KDEFDMP
          PROC NUSK$MP ;                                                 KDEFDMP
          PROC FIXX$AA ;                                                 KDEFDMP
          PROC UNFX$AA ;                                                 KDEFDMP
          PROC SEBL$AA ;                                                 KDEFDMP
          PROC STMD$AA ;                                                 KDEFDMP
          PROC LOCB$AA ;                                                 KDEFDMP
          PROC LOCR$AA ;                                                 KDEFDMP
          PROC MSGF$AA ;                                                 GBK0201
          END                                                            KDEFDMP
                                                                         KDEFDMP
      ITEM ERCOD ;           #USED TO STORE ERROR CODE#                  JJJ0405
      ITEM N ;               #INCOMING PARAMETER#                        AM2A077
      ITEM AA ;              #BLOCK PRU NUMBER#                          AM2A077
      ITEM AB ;              #INDUCTION VARIABLE USED AS RECORD NO.#     AM2A077
      ITEM CC ;              #BLOCK NO.#                                 AM2A077
      ITEM X ;               #EXTENT OF RECORD AND COUNT INCREMENT#      AM2A077
                                                                         JJJ0405
          IF B<KDKDDM>W[N] EQ FSPKD[ FTMIPFS[0]-P<FSTT$AA> ]             GBK0107
              THEN GOTO RETERN ;  #DEFINITION OF PRIMARY KEY# 
          STMD$AA( 16 );                                                 KDEFDMP
          MPAKD[0] = W[N] ;                                              KDEFDMP
          KRAK$MP ( 1 ) ;                                                KDEFDMP
          IF AKL EQ 0                                                    GBK0201
          THEN               #SCC DEFINITION#                            AM2A077
              BEGIN                                                      AM2A077
              IF FSSCCLG                                                 AM2A077
              THEN                                                       AM2A077
                  BEGIN                                                  AM2A077
                  ERCOD = EC527 ;  #REDEFINITION OF SCC VERBOTEN#        AM2A077
                  GOTO FATERR ;                                          AM2A077
                  END                                                    AM2A077
              FSSCCWD = AKW ;      #SET FSTT SCC DESCRIPTORS#            AM2A077
              FSSCCPO = AKP ;                                            AM2A077
              FSSCCLG = TRUE ;                                           AM2A077
              AB = FTFSTT[0] - P<FSTT$AA> ;                              GAG1103
              FSSCCWD[AB] = AKW ;                                        GAG1103
              FSSCCPO[AB] = AKP ;                                        GAG1103
              FSSCCLG[AB] = TRUE ;                                       GAG1103
              GOTO RETERN ; 
              END                                                        AM2A077
          IF AKT EQ KT"SIGNED"                                           CIM0801
          THEN               #CHECK POSITION AND LENGTH#                 AM2A077
              BEGIN                                                      CIM0801
              IF AKP NQ 0 OR AKL NQ 10                                   CIM0801
              THEN                                                       CIM0801
                  BEGIN                                                  CIM0801
                  ERCOD = EC505 ;  #ERROR IN RMKDEF PARAMETER#           CIM0801
                  GOTO FATERR ;                                          CIM0801
                  END                                                    AM2A077
              END                                                        CIM0801
          X = MPAKG * (MPAKC-1);                                         AM2A077
          IF X GQ 0          #EITHER REPEATING GRP OR SINGLE#            AM2A077
                             #NOT A OCCURS DEPENDING ON#                 AM2A077
          THEN                                                           AM2A077
              BEGIN                                                      AM2A077
              X = 10 * AKW + AKP + AKL + X;   #EXTENT OF KEY#            AM2A077
              IF X GR FTMRL OR X GR FTMNR  #KEY OUTSIDE#                 AM2A077
              THEN                                                       AM2A077
                  BEGIN                                                  AM2A077
                  ERCOD = EC206;                                         AM2A077
                  GOTO FATERR;                                           AM2A077
                  END                                                    AM2A077
              END                                                        AM2A077
          IF AKS EQ FO"FIFO" AND MPAKG[0] NQ 0 AND AKC NQ 1              AM2A077
          THEN                                                           AM2A077
              BEGIN                                                      AM2A077
              ERCOD = EC540 ;      #FIFO ILLEGAL IN RPT GROUP#           AM2A077
              GOTO FATERR ;                                              AM2A077
              END                                                        AM2A077
          BARREN = 0 ;                                                   KDEFDMP
          NEWLNG = KDEFRL;                                               GBK0121
          NEWFWA = N ;                                                   KDEFDMP
          KEYFWA = N ;                                                   KDEFDMP
          WKKY$IS ( 1 ) ;                                                KDEFDMP
          IF QMF EQ 0                                                    KDEFDMP
          THEN               #NO MATCH ON KEYDEF RECORD#                 AM2A077
              BEGIN          #INSERTION PROCESS#                         AM2A077
              IF AKT LS 0                                                JJJ0405
              THEN                                                       JJJ0405
                  BEGIN                                                  JJJ0405
                  ERCOD = EC541; #PURGE ILLEGAL IF KEY NOT KNOWN# 
                  GOTO FATERR;                                           JJJ0405
                  END                                                    JJJ0405
              PTRP$IS ( 1 ) ; #INSERT#                                   KDEFDMP
              CURR$AA ;                                                  KDEFDMP
              NUSK$MP ;                                                  KDEFDMP
              X = 1 ;        #COUNT INCREMENT FOR SUBSTRUCTURE TYPE#     AM2A077
              IF AKL GR FSMXALTKY                                        GBK0107
              THEN                                                       AM2A077
                  BEGIN                                                  AM2A077
                  FSMXALTKY = AKL ;                                      AM2A077
                  END                                                    AM2A077
              END                                                        AM2A077
          ELSE               #KEYDEF RECORD MATCH#                       AM2A077
              BEGIN          #PURGE PROCESS#                             AM2A077
              P<MPAT$AA> = RECFWA ; 
              AKS = MPAKS[0] ; #MUST GET U/I/F FROM THE OLD RECORD# 
              IF AKT GQ 0                                                JJJ0405
              THEN                                                       JJJ0405
                  BEGIN                                                  JJJ0405
                  ERCOD = EC542; #CANT ADD EXISTING KEYDEF# 
                  GOTO FATERR;                                           JJJ0405
                  END                                                    JJJ0405
              IF SUBFLAG NQ 0                                            KDEFDMP
              THEN           #RECORD HAS SUBFILE#                        AM2A077
                  BEGIN                                                  AM2A077
                  P<SFH$MP> = RECLWA - 3 ;                               KDEFDMP
                  AA = SFHFB[0] LAN ( 2**24-1 ) ; 
                  END                                                    AM2A077
              ELSE           #NO SUBFILE#                                AM2A077
                  BEGIN                                                  AM2A077
                  AA = 0 ;                                               AM2A077
                  END                                                    AM2A077
              DLTE$IS ;      #DELETE KEYDEF RECORD#                      AM2A077
              ASLONGAS AA NQ 0                                           KDEFDMP
                  DO BEGIN                                               AM2A077
                  PTCURBLK[1] = AA ; #CHEAT A LITTLE#                    KDEFDMP
                  SEBL$AA ( 1 , 1 ) ;                                    KDEFDMP
                  AA = FWD ;                                             KDEFDMP
                  IF UR EQ 0                                             KDEFDMP
                  THEN       #RECORDS NOT UNIFORM#                       AM2A077
                      BEGIN                                              AM2A077
                      FOR AB = 1 STEP 1 UNTIL RC                         AM2A077
                          DO BEGIN                                       AM2A077
                          LOCR$AA ( AB ) ;                               KDEFDMP
                          IF SUBFLAG NQ 0 AND UCCFIELD NQ DEAD           KDEFDMP
                          THEN     #SUBFILE PRESENT#                     AM2A077
                              BEGIN                                      AM2A077
                              FIXX$AA ( P<BLOK$AA> , 0 ) ;               KDEFDMP
                              P<SFH$MP> = RECLWA - 3 ;                   KDEFDMP
                              IF SFHLG[0] EQ SUFHLG   #3#                KDEFDMP
                              THEN                                       AM2A077
                                  BEGIN                                  AM2A077
                                  CC = SFHFB[0] ;                        KDEFDMP
                                  ASLONGAS CC NQ 0                       KDEFDMP
                                      DO BEGIN                           AM2A077
                                      LOCB$AA ( CC , 1 ) ;               KDEFDMP
                                      IF P<BLOK$AA> LS 0
                                      THEN
                                          BEGIN 
                                          MSGF$AA ( EC135 ) ; 
                                          END   #READ ERROR#
                                      CC = FWD ;                         KDEFDMP
                                      AWAYCHN;                          000180
                                      END                                AM2A077
                                  END                                    AM2A077
                              UNFX$AA ( 0 ) ;                            KDEFDMP
                              SEBL$AA ( 1 , 1 ) ;                        KDEFDMP
                              END                                        AM2A077
                          END                                            AM2A077
                      END                                                AM2A077
                  AWAYCHN;                                              000200
                  END                                                    AM2A077
              X = -1 ;       #COUNT DECREMENT FOR SUBSTRUCTURE TYPE#     AM2A077
              END                                                        AM2A077
          IF AKS EQ FO"UNIQUE"                                           KDEFDMP
          THEN               #ADJUST -UNIQUE- COUNT#                     AM2A077
              BEGIN                                                      AM2A077
              FSKDUNCT[0] = FSKDUNCT[0] + X ;                            AM2A077
              END                                                        AM2A077
          ELSE                                                           AM2A077
              BEGIN                                                      AM2A077
              IF AKS EQ FO"IS"                                           AM2A077
              THEN           #ADJUST -IS- COUNT#                         AM2A077
                  BEGIN                                                  AM2A077
                  FSKDISCT[0] = FSKDISCT[0] + X ;                        AM2A077
                  END                                                    AM2A077
              ELSE           #ADJUST -FIFO- COUNT#                       AM2A077
                  BEGIN                                                  AM2A077
                  FSKDFICT[0] = FSKDFICT[0] + X ;                        AM2A077
                  END                                                    AM2A077
              END                                                        AM2A077
          GOTO RETERN ; 
                                                                         JJJ0405
                                                                         JJJ0405
FATERR:   MSGF$AA (ERCOD);                                               JJJ0405
  RETERN: 
          FSMODFLG [FTFSTT[0] - P<FSTT$AA>] = FALSE;
          RETURN;                                                        JJJ0405
          END #KDEF$MP# TERM                                             KDEFDMP
