*DECK MIPDIS                                                             MIPDIS 
PRGM MIPDIS ;                                                            MIPDIS 
 #                                                                       CIM0808
* *   MIPDIS - UTILITY FOR MIP ASSOCIATION/DISASSOCIATION                CIM0808
* *   C.MCDONALD                                                         CIM0808
* 1DC MIPDIS                                                             CIM0808
*                                                                        CIM0808
* DC  FUNCTION                                                           CIM0808
*                                                                        CIM0808
*     UTILITY THAT DISASSOCIATES A MIP FILE FROM ITS DATA FILE OR        CIM0808
*     ASSOCIATES A MIP FILE WITH A DATA FILE.                            CIM0808
*                                                                        CIM0808
* DC  ENTRY CONDITIONS                                                   CIM0808
*                                                                        CIM0808
*     FOR ASSOCIATION THE USER MUST HAVE A DATA AND MIP FILE DEFINED.    CIM0808
*     FOR DISASSOCIATION THE USER MUST HAVE A DATA FILE DEFINED.         CIM0808
*     FOR BOTH MODES, THE DATA FILE MUST BE ATTACHED WITH MODIFY         CIM0808
*     PERMISSION.                                                        CIM0808
*     THE CONTROL STATEMENT FORMAT IS MIPDIS( DFN, MODE, MFN ).          CIM0808
*       DFN  - LOGICAL FILE NAME OF DATA FILE                            CIM0808
*       MFN  - LOGICAL FILE NAME OF MIP FILE                             CIM0808
*       MODE - D FOR DISASSOCIATION (DEFAULT)                            CIM0808
*            - A FOR ASSOCIATION.                                        CIM0808
*                                                                        CIM0808
* DC  ERROR CONDITIONS                                                   CIM0808
*                                                                        CIM0808
*     MIPDIS ABORTS WITH AN INFORMATIVE DAYFILE MESSAGE WHEN             CIM0808
*       - THE PARAMETER LIST IS IN ERROR.                                CIM0808
*       - THE FIRST BLOCK OF THE FILE IS NOT AN FSTT.                    CIM0808
*       - THE DATA OR MIP FILE ORGANIZATION IS UNKNOWN.                  CIM0808
*       - THERE IS A CHECKSUM ERROR ON THE FSTT.                         CIM0808
*       - THE MIP FILE ISNT DEFINED (ASSOCIATION MODE).                  CIM0808
*       - THE DATA FILE IS NOT MIPPED (DISASSOCIATION MODE).             CIM0808
*       - THE DATA FILE AND MIP FILE PRIMARY KEY DEF IS DIFFERENT        CIM0808
*         (ASSOCIATION MODE).                                            CIM0808
*                                                                        CIM0808
* DC  CALLED ROUTINES                                                    CIM0808
*                                                                        CIM0808
*     CIO$REQ - ISSUES CIO REQUESTS.                                     CIM0808
*     MSG$ - ISSUES DAYFILE MESSAGES.                                    CIM0808
*                                                                        CIM0808
* DC  DESCRIPTION                                                        CIM0808
*                                                                        CIM0808
*     FOR DISASSOCIATION -                                               CIM0808
*      -OPEN DATA FILE VIA CIO REQUEST.                                  CIM0808
*      -READ DATA FILE FSTT AND VERIFY IT IS A DA, IS, OR AK FSTT.       CIM0808
*      -ISSUE AN ERROR IF THE DATA FILE ISNT MIPPED AND ABORT.           CIM0808
*      -ZERO OUT THE FSTT MIPWORD.                                       CIM0808
*      -SET THE FSTT DISASSOC FLAG TO 1.                                 CIM0808
*      -COMPUTE THE FSTT CHECKSUM AND RESET THE FSTT CHECKSUM FIELD.     CIM0808
*      -REWRITE THE DATA FILE FSTT VIA CIO REQUEST.                      CIM0808
*      -CLOSE THE DATA FILE VIA CIO REQUEST.                             CIM0808
*      -ISSUE DAYFILE MESSAGE- DISASSOCIATION COMPLETE.                  CIM0808
*     FOR ASSOCIATION -                                                  CIM0808
*      -OPEN DATA FILE VIA CIO REQUEST.                                  CIM0808
*      -READ DATA FILE FSTT AND VERIFY IT IS A DA, IS, OR AK FILE FSTT.  CIM0808
*      -ISSUE ERROR IF MIP FILE ISNT DEFINED AND ABORT.                  CIM0808
*      -OPEN MIP FILE VIA CIO REQUEST.                                   CIM0808
*      -READ MIP FSTT AND VERIFY THAT ITS A MIP FILE FSTT.               CIM0808
*      -COPY MIPWORD, MXALTKY, PKW, PKP, PKL, PKT, PT2SZ, AND PT3SZ FROM CIM0808
*       MIP FSTT TO TEMPORARY LOCATIONS.                                 CIM0808
*      -ISSUE ERROR IF MIP AND DATA FILE PRIMARY KEY DEFS ARENT EQUAL.   CIM0808
*      -COPY MIP FSTT MIPWORD, MXALTKY, PT2SZ, AND PT3SZ TO DATA FSTT.   CIM0808
*      -SET THE DATA FSTT DISASSOC FLAG TO 2.                            CIM0808
*      -COMPARE THE DATA FILE FSTT CHECKSUM AND RESET THE CHECKSUM.      CIM0808
*      -REWRITE THE DATA FILE FSTT VIA CIO REQUEST.                      CIM0808
*      -CLOSE BOTH DATA AND MIP FILE VIA CIO REQUESTS.                   CIM0808
*      -ISSUE DAYFILE MESSAGE - ASSOCIATION COMPLETE.                    CIM0808
*                                                                        CIM0808
 #                                                                       CIM0808
      BEGIN                                                              MIPDIS 
      XREF                                                               MIPDIS 
          BEGIN                                                          MIPDIS 
          PROC MSG$ ;        #FOR DAY FILE MSSSAGES#                     MIPDIS 
          PROC CIO$REQ ;     #FOR CIO REQUESTS#                          MIPDIS 
          END                                                            MIPDIS 
      DEF SZBUF  #129# ;     #SIZE OF BUFFER#                            MIPDIS 
      DEF SZFET  #9# ;       #SIZE OF FET#                               MIPDIS 
      DEF SZFSTT #126# ;     #SIZE OF FSTT#                              MIPDIS 
      DEF CIOOPN #O"100"# ;  #OPEN CODE#                                 MIPDIS 
      DEF CIOCLS #O"150"# ;  #CLOSE CODE#                                MIPDIS 
      DEF CIORED #O"010"# ;  #READ CODE#                                 MIPDIS 
      DEF CIORWR #O"224"# ;  #REWRITER CODE#                             MIPDIS 
      DEF RECALL #1#;                                                    MIPDIS 
*CALL AAMARRDEF                                                          MIPDIS 
*CALL AAMFSTT                                                            MIPDIS 
*CALL AAMFETHD
*CALL AAMFETDCL                                                          MIPDIS 
      ITEM LENGTH I ;                                                    MIPDIS 
      ITEM ISFILE  B = FALSE ;                                           MIPDIS 
      ITEM MIPFILE B = FALSE ;                                           MIPDIS 
      ITEM DAFILE  B = FALSE ;                                           MIPDIS 
      ITEM AKFILE  B = FALSE ;                                           MIPDIS 
      ITEM MIPWORD I ;                                                   MIPDIS 
      ITEM MXALTKY U ;                                                   MIPDIS 
      ITEM PT2SZ U ;                                                     MIPDIS 
      ITEM PT3SZ U ;                                                     MIPDIS 
      ITEM PKW U ;                                                       MIPDIS 
      ITEM PKP U ;                                                       MIPDIS 
      ITEM PKL U ;                                                       MIPDIS 
      ITEM PKT U ;                                                       MIPDIS 
      ARRAY DATAFSTT [1:SZBUF] ; ;                                       MIPDIS 
      ARRAY MIPFSTT  [1:SZBUF] ; ;                                       MIPDIS 
      BASED ARRAY CCPARAM S(1);       #REFERENCES CONTROL CARD PARAMS#   MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DATALFN  C(02,00,07) ;                                    MIPDIS 
          ITEM MODE     C(03,00,01) ;                                    MIPDIS 
          ITEM MIPLFN   C(04,00,07) ;                                    MIPDIS 
          ITEM PARAMCT  I(52,42,18) ;                                    MIPDIS 
          END                                                            MIPDIS 
      ARRAY DATAFET [1:SZFET] ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DFFET I = [ SZFET(0) ] ;                                  MIPDIS 
          END                                                            MIPDIS 
      ARRAY MIPFET  [1:SZFET] ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM MFFET I = [ SZFET(0) ] ;                                  MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG1 [0:0] P(3) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG1 C(00,00,28) = ["ERROR IN PARAMETER LIST"] ;       MIPDIS 
          ITEM MSGTRM1 I(02,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG2 [0:0] P(4) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG2 C(00,00,38) = ["DATA FILE ORGANIZATION UNKNOWN"]; MIPDIS 
          ITEM MSGTRM2 I(03,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG3 [0:0] P(3) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG3 C(00,00,28) = ["DISASSOCIATION COMPLETE"] ;       MIPDIS 
          ITEM MSGTRM3 I(02,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG4 [0:0] P(3) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG4 C(00,00,28) = ["ASSOCIATION COMPLETE"] ;          MIPDIS 
          ITEM MSGTRM4 I(02,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG5 [0:0] P(3) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG5 C(00,00,28) = ["FIRST BLOCK OF FILE NOT FSTT"] ;  MIPDIS 
          ITEM MSGTRMS I(02,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG6 [0:0] P(4) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG6 C(00,00,38) = ["MIP FILE ORGANIZATION UNKNOWN"] ; MIPDIS 
          ITEM MSGTRM6 I(03,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG7 [0:0] P(7) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG7 C(00,00,40) = ["DATA AND MIP FILE INCOMPATIBLE"]; MIPDIS 
          ITEM MSG7    C(04,00,28) = ["PRIMARY KEY DEFS DIFFERENT"] ;    MIPDIS 
          ITEM MSGTRM7 I(06,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG8 [0:0] P(3) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG8 C(00,00,28) = ["CHECKSUM ERROR ON FSTT"] ;        MIPDIS 
          ITEM MSGTRM8 I(02,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG9 [0:0] P(3) ;                                          MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG9 C(00,00,28) = ["ERROR - DATA FILE NOT MIPPED"] ;  MIPDIS 
          ITEM MSGTRM9 I(02,48,12) = [O"0000"] ;                         MIPDIS 
          END                                                            MIPDIS 
      ARRAY DFMSG10 [0:0] P(3) ;                                         MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM DYFMSG10 C(00,00,28) = ["ERROR- NO MIP FILE SPECIFIED"];  MIPDIS 
          ITEM MSGTRM10 I(02,48,12) = [O"0000"] ;                        MIPDIS 
          END                                                            MIPDIS 
      FUNC CKSUM U ;                                                     MIPDIS 
          BEGIN                                                          MIPDIS 
          ITEM T1 ;                                                      MIPDIS 
          ITEM T2 ;                                                      MIPDIS 
          T1 = 0 ;                                                       MIPDIS 
          FOR T2 = 2 STEP 1 UNTIL SZFSTT DO                              MIPDIS 
              BEGIN                                                      MIPDIS 
              T1 = T1 + FSFRM3[ T2 ] ;                                   MIPDIS 
              END                                                        MIPDIS 
          T1 = B<0,30>T1 + B<30,30>T1 ;                                  MIPDIS 
          CKSUM = B<30,30>T1 ;                                           MIPDIS 
          END                                                            MIPDIS 
      PROC OPEN ;                                                        MIPDIS 
          BEGIN                                                          MIPDIS 
          FECMPLT = 1 ;                                                  MIPDIS 
          FESRB = 0 ;                                                    MIPDIS 
          FELNG = 3 ;                                                    MIPDIS 
          CIO$REQ( P<FET$AA>, RECALL, CIOOPN ) ;                         MIPDIS 
          FESRB = 1 ;        # RANDOM FILE BIT #                         MIPDIS 
          FEFCSE = 1 ;                                                   MIPDIS 
          END                                                            MIPDIS 
      PROC READFSTT ;                                                    MIPDIS 
          BEGIN                                                          MIPDIS 
          FEPRUNO = 1 ;                                                  MIPDIS 
          CIO$REQ( P<FET$AA>, RECALL, CIORED) ;                          MIPDIS 
          LENGTH = FEIN - FEFIRST ;                                      MIPDIS 
          IF FEFCSE NQ O"21" OR LENGTH NQ SZFSTT                         MIPDIS 
          THEN               # FIRST BLOCK NOT ISTT #                    MIPDIS 
              BEGIN                                                      MIPDIS 
              MSG$( DFMSG5 ) ;                                           MIPDIS 
              END                                                        MIPDIS 
          IF FSBLCHKSUM NQ CKSUM                                         MIPDIS 
          THEN               # CHECKSUM ERROR ON READ #                  MIPDIS 
              BEGIN                                                      MIPDIS 
              MSG$( DFMSG8 ) ;                                           MIPDIS 
              END                                                        MIPDIS 
          END                                                            MIPDIS 
      PROC WRITEFSTT ;       # REWRITER #                                MIPDIS 
          BEGIN                                                          MIPDIS 
          FEIN = LOC( DATAFSTT ) + SZFSTT ;                              MIPDIS 
          FEOUT = LOC( DATAFSTT ) ;                                      MIPDIS 
          FEPRUNO = 1 ;                                                  MIPDIS 
          CIO$REQ( P<FET$AA>, RECALL, CIORWR ) ;                         MIPDIS 
          END                                                            MIPDIS 
      PROC CLOSE ;                                                       MIPDIS 
          BEGIN                                                          MIPDIS 
          FESRB = 0 ;                                                    MIPDIS 
          CIO$REQ( P<FET$AA>, RECALL, CIOCLS ) ;                         MIPDIS 
          END                                                            MIPDIS 
                                                                         MIPDIS 
      P<CCPARAM> = 0 ;       # EXECUTION STARTS HERE #                   MIPDIS 
      IF PARAMCT EQ 0 OR PARAMCT GR 3                                    MIPDIS 
      THEN                   # PARAMETER LIST IN ERROR #                 MIPDIS 
          BEGIN                                                          MIPDIS 
          MSG$( DFMSG1 ) ;                                               MIPDIS 
          END                                                            MIPDIS 
      P<FET$AA> = LOC( DATAFET ) ;                                       MIPDIS 
       C<0,7>FELFN = DATALFN ;                                           MIPDIS 
      FEFIRST = LOC( DATAFSTT ) ;                                        MIPDIS 
      FEIN = LOC( DATAFSTT ) ;                                           MIPDIS 
      FEOUT = LOC( DATAFSTT ) ;                                          MIPDIS 
      FELIMIT = LOC( DATAFSTT ) + SZBUF + 1 ;                            MIPDIS 
      OPEN ;                 # DATA FILE #                               CIM0808
      P<FSTT$AA> = LOC( DATAFSTT ) - 3 ;                                 MIPDIS 
      READFSTT ;             # DATA FILE FSTT #                          MIPDIS 
      IF C<0,10>FSHEADW EQ "SAAM/IS"                                     MIPDIS 
      THEN                                                               MIPDIS 
          BEGIN                                                          MIPDIS 
          ISFILE = TRUE ;                                                MIPDIS 
          END                                                            MIPDIS 
      IF C<0,10>FSHEADW EQ "SAAM/DA"                                     MIPDIS 
      THEN                                                               MIPDIS 
          BEGIN                                                          MIPDIS 
          DAFILE = TRUE ;                                                MIPDIS 
          END                                                            MIPDIS 
      IF C<0,10>FSHEADW EQ "SAAM/AK"                                     MIPDIS 
      THEN                                                               MIPDIS 
          BEGIN                                                          MIPDIS 
          AKFILE = TRUE ;                                                MIPDIS 
          END                                                            MIPDIS 
      IF NOT ISFILE                                                      MIPDIS 
      AND NOT AKFILE                                                     MIPDIS 
      AND NOT DAFILE                                                     MIPDIS 
      THEN                   # DATA FILE ORGANIZATION UNKNOWN #          MIPDIS 
          BEGIN                                                          MIPDIS 
          MSG$( DFMSG2 ) ;                                               MIPDIS 
          END                                                            MIPDIS 
      IF PARAMCT EQ 1                                                    MIPDIS 
      OR MODE EQ "D"                                                     MIPDIS 
      THEN                   # DISASSOCIATE #                            MIPDIS 
          BEGIN                                                          MIPDIS 
          IF FSMIPWORD EQ 0                                              MIPDIS 
          THEN               # ERROR - DATA FILE NOT MIPPED #            MIPDIS 
              BEGIN                                                      MIPDIS 
              MSG$( DFMSG9 ) ;                                           MIPDIS 
              END                                                        MIPDIS 
          FSMIPWORD = 0 ;                                                MIPDIS 
          FSDISASSOC = 1 ;                                               MIPDIS 
          FSBLCHKSUM = CKSUM ;   # RESET FSTT CHECKSUM #                 MIPDIS 
          WRITEFSTT ;        # DATA FILE FSTT #                          MIPDIS 
          CLOSE ;                                                        MIPDIS 
          MSG$( DFMSG3 ) ;   # DISASSOCIATION COMPLETE #                 MIPDIS 
          END                                                            MIPDIS 
                                                                         MIPDIS 
      IF MODE EQ "A"                                                     MIPDIS 
      THEN                                                               MIPDIS 
          BEGIN                                                          MIPDIS 
          IF PARAMCT NQ 3                                                MIPDIS 
          THEN               # ERROR - NO MIP FILE SPECIFIED #           MIPDIS 
              BEGIN                                                      MIPDIS 
              MSG$( DFMSG10 ) ;                                          MIPDIS 
              END                                                        MIPDIS 
          P<FSTT$AA> = LOC( MIPFSTT ) - 3 ;                              MIPDIS 
          P<FET$AA> = LOC( MIPFET ) ;                                    MIPDIS 
       C<0,7>FELFN = MIPLFN ;                                            MIPDIS 
          FEFIRST = LOC( MIPFSTT ) ;                                     MIPDIS 
          FEIN = LOC( MIPFSTT ) ;                                        MIPDIS 
          FEOUT = LOC( MIPFSTT ) ;                                       MIPDIS 
          FELIMIT = LOC( MIPFSTT ) + SZBUF + 1 ;                         MIPDIS 
          OPEN ;             # MIP FILE #                                CIM0808
          READFSTT ;         # MIP FILE FSTT #                           MIPDIS 
          IF C<0,10>FSHEADW NQ "SAAM/MIP"                                MIPDIS 
          THEN               # PARAM 3 NOT A MIP FILE #                  MIPDIS 
              BEGIN                                                      MIPDIS 
              MSG$( DFMSG6 ) ;                                           MIPDIS 
              END                                                        MIPDIS 
          MIPWORD = FSMIPWORD ;                                          MIPDIS 
          MXALTKY = FSMXALTKY ;                                          MIPDIS 
          PKW = FSPKW ;                                                  MIPDIS 
          PKP = FSPKP ;                                                  MIPDIS 
          PKL = FSPKL ;                                                  MIPDIS 
          PKT = FSPKT ;                                                  MIPDIS 
          PT2SZ = FSPT2SZ ;                                              CIM0808
          PT3SZ = FSPT3SZ ;                                              CIM0808
          P<FET$AA> = LOC( DATAFET ) ;                                   MIPDIS 
          P<FSTT$AA> = LOC( DATAFSTT ) - 3 ;                             MIPDIS 
          IF FSKEYPOS NQ PKP                                             MIPDIS 
          OR FSKEYTYPE NQ PKT                                            MIPDIS 
          OR FSKEYLOC NQ PKW                                             MIPDIS 
          OR FSKEYSIZE NQ PKL                                            MIPDIS 
          THEN               #ERROR -MIP AND DATA FILE INCOMPATIBLE #    MIPDIS 
              BEGIN                                                      MIPDIS 
              MSG$( DFMSG7 ) ;                                           MIPDIS 
              END                                                        MIPDIS 
          FSPT2SZ = PT2SZ ;                                              MIPDIS 
          FSPT3SZ = PT3SZ ;                                              MIPDIS 
          FSMIPWORD = MIPWORD ;                                          MIPDIS 
          FSMXALTKY = MXALTKY ;                                          MIPDIS 
          FSDISASSOC = 2 ;                                               MIPDIS 
          FSBLCHKSUM = CKSUM ;                                           MIPDIS 
          WRITEFSTT ;        # DATA FILE FSTT #                          MIPDIS 
          CLOSE ;            # DATA FILE #                               MIPDIS 
          P<FET$AA> = LOC( MIPFET ) ;                                    MIPDIS 
          CLOSE ;            # MIP FILE #                                MIPDIS 
          MSG$( DFMSG4 ) ;   # ASSOCIATION COMPLETE #                    MIPDIS 
          END                                                            MIPDIS 
      END                                                                MIPDIS 
TERM                                                                     MIPDIS 
