         SYSTEM   SIG7FDP
         TITLE    'PHASE 4.2 - DISPLAY,SORT,REPORT'
* READ PROC                                                             APR
* LF     R---     R-,+/-HW OFFSET,INDIRECT ADDR.                        APR  1
RMCF     CNAME    1                                                     APR01
         PROC                                                           APR04
LF       BAL,L1   RDMCF             READ MCF CLUSTER
         SLS,R2   -1                BA(CLOC) TO HA
         DO       NUM(AF(1))                                            APR30
         LW,AF(1) R2                LOAD HA(CLOC)+/- HW OFFSET          APR31
         DO       NUM(AF(2))                                            APR40
         AI,AF(1) AF(2)                                                 APR41
         ELSE                                                           APR42
         AI,AF(1) -1                SET HA(CLOC)-1
         FIN                                                            APR44
         FIN                                                            APR44
         PEND                                                           APR50
* WRITE PROC                                                            APW
* LF     W---     R-,BA(CLOC)+/-BA OFFSET,RETURN                        APW 1
WPOF     CNAME    0                                                     APW00
         PROC                                                           APW03
         DO       NUM(AF(2))                                            APW11
LF       LI,R4    AF(2)             LOAD BA(CLOC)                       APW12
         ELSE                                                           APW13
         DO       NUM(AF(1))                                            APW132
LF       LW,R4    AF(1)             LOAD,SET HA(CLOC) TO BA             APW14
         AW,R4    R4                                                    APW15
         FIN                                                            APW16
         FIN                                                            APW17
         DO       NUM(AF(4))
         B        WRPOF             WRITE POF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1     AF(3)
         B        WRPOF             WRITE POF CLUSTER                   APW841
         ELSE                                                           APW842
         BAL,L1   WRPOF             WRITE POF CLUSTER                   APW843
         FIN                                                            APW844
         FIN                                                            APW848
         PEND                                                           APW90
* DIAG PROC                                                             APD
DX       CNAME                                                          APD00
         PROC                                                           APD01
* AF     DX       DIAG CODE,LINK                                        APD02
LF       LI,R1    AF(1)             LOAD DIAG CODE                      APD10
         DO       NUM(AF(3))
         B        DIAG
         ELSE
         DO       NUM(AF(2))
         LI,L1    AF(2)             LOAD LINK REGISTER
         B        DIAG              WRITE DMF CLUSTER                   APD242
         ELSE                                                           APD243
         BAL,L1   DIAG              WRITE DMF CLUSTER                   APD244
         FIN                                                            APD248
         FIN                                                            APD29
         PEND                                                           APD40
* LINK(OR LOAD) AND BRANCH PROC                                         APL
* LF     LAB,L/R  BRANCH ADDRESS,LINK ADDRESS(OR LOAD VALUE)            APL  1
LAB      CNAME                                                          APL01
         PROC                                                           APL04
LF       LI,CF(2) AF(2)             SET LINK REGISTER                   APL12
         B        AF(1)             BRANCH                              APL14
         PEND                                                           APL90
* LOAD,BRANCH AND LINK                                                  PRL
LBAL     CNAME    0                                                     PRL01
         PROC                                                           PRL02
* LF     LBAL,L-  BRANCH,LOAD VALUE,V-                                  PRL09
         DO       NUM(AF(3))                                            PRL20
         LI,AF(3) AF(2)             LOAD VALUE                          PRL22
         ELSE                                                           PRL23
         LI,V0    AF(2)             LOAD VALUE                          PRL24
         FIN                                                            PRL28
         DO       NUM(CF(2))                                            PRL40
         BAL,CF(2) AF(1)            BRANCH                              PRL42
         ELSE                                                           PRL43
         BAL,L1   AF(1)             BRANCH                              PRL44
         FIN                                                            PRL48
         PEND                                                           PRL99
* EXTERNAL REFERENCES
         REF      BAA02             RETURN
         REF      BAA40             SAVE DATA
         REF      PIA00,PIA02,PIA06,PIA08,PIA20,PIA22,PIA26,PIA28
         REF      PII00,PII02,PII20,PII22
         REF      PIL00,PIL02,PIL06,PIL20,PIL22,PIL26
         REF      PID10,PID11,PID12,PID14,PID16,PID18
         REF      PIP00,PIP02,PIP20,PIP22
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PRB00,PRB02,PRB06,PRB20,PRB22,PRB26
         REF      PRC06
         REF      PRE00,PRE01,PRE02,PRE20,PRE21,PRE22
         REF      PRF00,PRF02,PRF06
         REF      PRG00,PRG02,PRG06,PRG20,PRG22,PRG26
         REF      PRT00,PRT02,PRT06,PRT20,PRT22,PRT26
         REF      PDB00,PDB02,PDB06
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PDL10,PDL12,PDL16
         REF      PDX06
         REF      PPI10,PPI11,PPI12
         REF      PIY00,PIY01,PIY02,PIY03
         REF      PIY20,PIY21,PIY22,PIY23
         REF      PIY30,PIY31,PIY32,PIY33
         REF      PIZ30,PIZ32
         REF      LRA00,LRA01,LRA02
         REF      LRR00,LRR01,LRR02
         REF      LRD00,LRD01
         REF      LRD10,LRD11,LRD20,LRD21
         REF      LRD40,LRD41,LRD42
         REF      LRD60,LRD61,LRD62,LRD80,LRD81,LRD82
         REF      LRL00,LRL01
         REF      MRR10,MRR11,MRR12
         REF      MRR40,MRR41,MRR42
         REF      MRR60,MRR61,MRR62,MRR80,MRR81,MRR82
         REF      NRR10,NRR11,NRR12
         REF      NRR40,NRR41,NRR42
         REF      NRR60,NRR61,NRR62,NRR80,NRR81,NRR82,NRR70
         REF      NRD00,NRD01,NRD02
         REF      ORR03,ORR04,ORR05,ORR06,ORR07,ORR08
         REF      ORD12,ORD22,ORD23,ORD24
         REF      ORD42,ORD44,ORD48
         REF      MTL20
         REF      SSB00,SSB01,SSB02
         REF      SSL00,SSL01,SSL02
         REF      SSS00,SSS01,SSS02
         REF      WRPOF
         REF      RDMCF
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
         REF      MCBUF,MDBUF
         REF      JDECP,JDSIZ       DECP,DSIZ
         REF      VEXBT
         REF      AJAD
* REGISTER EQUIVALENCES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6                                                     117
R7       EQU      7                                                     116
V0       EQU      8
V1       EQU      9
V2       EQU      10
L0       EQU      V2                                                    1212
L1       EQU      11                LINK REGISTER
D0       EQU      12                DECA
D1       EQU      13
D2       EQU      14
D3       EQU      15
RE       EQU      4                 EVEN
RO       EQU      5                 ODD
RB       EQU      R6                BIN
RFL      EQU      V0                FLP
RF       EQU      V2                FILE CNTL
RS       EQU      V2                SIGN - EDIT
RC       EQU      L1                %
P1       EQU      V2                PREG 1
SR1      EQU      8                 SR1
SR2      EQU      V1
SR3      EQU      X'A'              SR3
* BA(D-)
CBD0     EQU      X'30'
CBD1     EQU      X'34'                                                 CBD1
CBD2     EQU      X'38'                                                 CBD2
CBD3     EQU      X'36'                                                 CBD3
* INDEX REGISTERS                                                       CIR
CIR1     EQU      2                                                     CIR1
CIR2     EQU      4                                                     CIR2
CIR3     EQU      6                                                     CIR3
CIR4     EQU      8                                                     CIR4
CIR5     EQU      X'A'                                                  CIR5
CIR6     EQU      X'C'                                                  CIR6
CIR7     EQU      X'E'
* R REGISTERS
CRR1     EQU      X'10'                                                 CR01
CRR2     EQU      X'20'                                                 CR02
CRR3     EQU      X'30'                                                 CR03
CRR4     EQU      X'40'                                                 CR04
CRR5     EQU      X'50'                                                 CR05
CRR6     EQU      X'60'                                                 CR06
CRR7     EQU      X'70'                                                 CR07
CRV0     EQU      X'80'                                                 CR08
CRV1     EQU      X'90'                                                 CR09
CRV2     EQU      X'A0'                                                 CR10
CRL1     EQU      X'B0'                                                 CR11
CRD0     EQU      X'C0'                                                 CR12
CRD1     EQU      X'D0'                                                 CR13
CRD2     EQU      X'E0'                                                 CR14
CRD3     EQU      X'F0'                                                 CR15
CRE      EQU      X'40'             EVEN
CRO      EQU      X'50'             ODD
CRB      EQU      CRR6              BIN
CRFL     EQU      CRV0              FLP
CRF      EQU      CRV2              FILE CNTL
CRS      EQU      CRV2              SIGN - EDIT
CRC      EQU      CRL1              %
CP1      EQU      CRV2              PREG 1
CSR1     EQU      X'80'             SR1                                 CR3
CSR2     EQU      CRV1
CSR3     EQU      X'A0'             SR3                                 CR3
* OP CODES
CLCI     EQU      X'0220'
CCAL1    EQU      X'0400'           CAL1
CLD      EQU      X'1200'                                               C12
CSTD     EQU      X'1500'
CFAL     EQU      X'1D00'                                               C194
CAI      EQU      X'2000'                                               C20
CLI      EQU      X'2200'           LI                                  C22
CLI1     EQU      X'2210'           LI,1                                C221
CMI      EQU      X'2300'
CSF      EQU      X'2400'                                               C24
CS       EQU      X'2500'                                               C25
CAW      EQU      X'3000'
CSTW     EQU      X'3500'           STW                                 C35
CLW      EQU      X'3200'                                               C32
CSW      EQU      X'3800'
CSTS     EQU      X'4700'           STS                                 C47
CEOR     EQU      X'4800'           EOR                                 C48
CSAS     EQU      X'400'            RA SETING - SAS                     C484
CSDA     EQU      X'500'            RA SETTING - SAD                    C485
COR      EQU      X'4900'           OR                                  C49
CAND     EQU      X'4B00'
CLAH     EQU      X'5B00'
CMBS     EQU      X'6100'
CBDR     EQU      X'6400'                                               C64
CEXU     EQU      X'6700'                                               C67
CBR      EQU      X'6800'           B                                   C68
CBLE     EQU      X'6820'           BLE,BLEZ                            C682
CBEZ     EQU      X'6830'           BEZ                                 C683
CBAZ     EQU      X'6840'           BAZ                                 C684
CBL      EQU      X'6910'           BL                                  C691
CBNE     EQU      X'6930'           BNE,BNEZ
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
CSTB     EQU      X'7500'                                               C75
CPACK    EQU      X'7600'                                               C76
CUNPK    EQU      X'7700'
CDSA     EQU      X'7C00'
CDL      EQU      X'7E00'                                               C795
CDST     EQU      X'7F00'
CIND     EQU      X'8000'           INDIRECT BIT                        C900
* POF CLUSTER CLNG,CNTL
* INSTRUCTION TYPE
DAIA     EQU      X'0401'           CONSTANT
DAID     EQU      X'0609'           DATA
DAII     EQU      X'0402'           INTERNAL LABEL
DAIL     EQU      X'0406'           LOC. CNTR
DAIP     EQU      X'0404'           PAR/SEC NAME
DAIX     EQU      X'0108'           XREF
* DATA REFERENCE
DARA     EQU      X'0410'           ADCONS
DARB     EQU      X'0417'           BRANCH TABLE
DARE     EQU      X'0415'           EXIT TABLE
DARF     EQU      X'41A'            FILE LABEL
DARG     EQU      X'0414'           GLOBAL LITERALS
DARL     EQU      X'0418'           LOCAL LITERALS
DART     EQU      X'0417'           TEMP STG
* DATA DEF
DADA     EQU      X'052D'           AN
DADB     EQU      X'0621'           BINARY
DADD     EQU      X'0829'           DATA REF
DADL     EQU      X'0626'           LOC. CNTR
* DEFINITIONS/DECLARATIONS
DADX     EQU      X'0328'           EXTERNAL NAME
DAPI     EQU      X'0341'           INTERNAL LABEL
* GLOBAL LITERAL WA DISPL - BASE 4
DGDZ     EQU      4                 D'+0'
DGD1     EQU      3                 D'+1'
DGFZ     EQU      6                 FL'0.E8'
* GLOBAL LITERAL BA DISPL - BASE 4
DGZRO    EQU      0                 ZERO
DGSPC    EQU      1                 SPACE
DGQUO    EQU      2                 QUOTE
DGLV     EQU      3                 LOW-VALUE
DGHV     EQU      4                 HIGH-VALUE
DGAST    EQU      6                 ASTERISK
* REGISTER SAVE LEVELS
DSS      EQU      1                 SUBSCRIPT
DSL      EQU      2                 STORE
DSG      EQU      4                 GENERATOR
* TEMP REGISTER SAVE AREAS
DTB      EQU      9                 BIN
DTF      EQU      18                FLP
DTCSX    EQU      20                CORRESPONDING SXR1,SXR2
DTD1     EQU      10                DECA - SUBSCRIPT
DTD2     EQU      14                DECA - STORE
DTD4     EQU      22                DECA - GENERATORS
*
DTWA     EQU      28                WA TMP WORK AREA
DTBA     EQU      DTWA*4            BA TMP WORK AREA                    22
* ENTRY POINTS
         DEF      BBM00
         DEF      BCD00             SORT
         PAGE
         TITLE    'PHASE 4.2 - ACCEPT,DISPLAY'
*                        R6 = STMT OPTION(=TYPE INDEX)                   8
*                        D1 = DISPLAY IMAGE BLNG                         9
BBM00    RES      0
         LBAL     PIA02,CLI+CRR6    WRITE LI,RE DISPLAY BLNG            11
         MTW,0    VEXBT
         BEZ      BBMDE
         MTW,0    VEXBT+1
         BEZ      BBMDD
         LW,D1    AJAD              ADCON FOR VAR REC
         LBAL     PRA01,CSW+CRR6    **** WRITE SW,R6  (AJAD)
BBMDD    LI,V0    0
         STW,V0   VEXBT             CLEAR EXHIBIT FLAG
         STW,V0   VEXBT+1
BBMDE    CI,R6    3                 CHECK OPTION
         BE       BBM01             ACCEPT
         BAL,L1   PRT26             WRITE
         STB,R6   DTWA              ****     STORE DISPLAY BLNG         12
         CI,R6    1                 CHECK STMT OPTION
         BE       BBM0D             DISPLAY
         CI,R6    4
         BNE      BBM01             NOT UPON PRINTER
* DISPLAY
         BAL,L1   PIA06             WRITE
         LI,R1    X'40'             ****  LI,R1 NO RETURN CODE
         B        BBM0D+2
BBM0D    BAL,L1   PIA06             WRITE
         LI,R1    X'15'             ****  LI,R1 RETURN CODE
         LBAL     PRA24,CSTB+CRR1+CIR6 WRITE STB,R1 MSG AREA,R6
BBM01    RES      0
         LW,D3    JTEXT,R6          LOAD,CHECK TEXT FLAG                14
         BGEZ     BBM10             UP, TEXT,PLIST GENERATED            15
* GENERATE TEXT,PLIST                                                   16
         CI,R6    3                 CHECK OPTION
         BANZ     BBM010            NOT EXHIBIT
* EXHIBIT
         LD,V0    KPFDT             SET X'01',M:
         STD,V0   JADXC+1
         BAL,L1   PDX06             WRITE
         TEXT     ':LL '            ****  X'01',M:LL
         LD,V0    KPFDT+2           RESTORE C:
         STD,V0   JADXC+1
         B        BBM020
* NOT EXHIBIT(PRINT)
BBM010   RES      0
         BNE      BBM02             NOT ACCEPT
* ACCEPT
         LD,D2    KTEXT             LOAD TEXT(='ACCEPT')
         LBAL     PDD04,DADA+X'300',D0 WRITE AN TEXT CLUSTER
         MTW,4    GADNO             ADCON NO. = ADCON NO.+1
         LW,V1    D1                SAVE  TEXT  BASE,DISPL
BBM02    RES      0
         LH,V0    KODE,R6           LOAD CODE
         LBAL     PDB02,0,D2        WRITE FPT WORD 0- CODE,0
BBM020   RES      0
         STW,D1   JTEXT,R6          RAISE TEXT(/PLIST) FLAG(=DISPL)     22
*                                                                       37
         LI,V0    X'8000'           LOAD P1 PRESENT BIT                 43
         LW,D3    KMSG              LOAD MSG AREA BASE,DISPL
         CI,R6    2                 CHECK STMT OPTION
         BL       BBM04             M:TYPE/M:PRINT
* M:KEYIN                                                               46
         BE       BBM03             STOP
         CI,R6    4
         BE       BBM04             M:PRINT
* ACCEPT
         LW,D3    V1                LOAD TEXT BASE,DISPL
BBM03    RES      0
         AI,V0    X'7000'           SET P2-P4 PRESENT BITS
BBM04    RES      0                                                     48
         BAL,L1   PDB02             WRITE FPT WORD 1 - 'PRESENCE BITS'  49
         LBAL     PDD01,0           WRITE FPT WORD 2 - WA(MSG AREA)
*                        D3 = MSG AREA BASE,DISPL                       54
         CI,R6    1                 CHECK STMT OPTION                   55
         BLE      BBM08             </=. M:TYPE/M:PRINT                 55
         CI,R6    4
         BE       BBM08             M:PRINT
* M:KEYIN                                                               56
         LW,D3    KMSG              LOAD REPLY BASE,DISPL
         BAL,L1   PDD04             WRITE FPT WORD 3 - WA(REPLY)
         BAL,L1   PDB06             WRITE
         DATA     11                ****  FPT WORD 4 - REPLY BLNG
* **                     PRESET FOR STOP LITERAL
         LW,D3    GADNO             LOAD WA(ECB)(=NEXT ADCON)           63
         AI,D3    8                                                     64
         BAL,L1   PDD01             WRITE FPT WORD 5 - WA(ECB)          65
         LBAL     PDD04,DADB,D0     WRITE ECB WORD                      67
* **                     ECB = DATA 2
BBM08    RES      0                                                     71
         LW,D3    JTEXT,R6          LOAD TEXT DISPL                     72
*                        D3 = PLIST DISPL
BBM10    RES      0
         CI,R6    3                 CHECK OPTION
         BNE      BBM12             NOT ACCEPT
* ACCEPT
* **                     R6 = REPLY BLNG
         AI,D3    16                ADJUST DISPL TO FPT WORD 4
         STW,D3   TEMPX             SAVE MAXL ADDR                      COBOL42J
         BAL,L1   PID16             WRITE
         STW,R6   2                 ****  STW,R6 FPT WORD 4
         LW,D3    KMSG              WRITE FILL REPLY
         AI,D3    1
         BAL,L1   PID16
         LI,R1    0
         BAL,L1   PIA26
         STB,R6   R1
         LW,D3    K4SPAC
         BAL,L1   PID16
         MBS,0    0
         LW,D3    JTEXT,R6          FPT WORD 0
BBM12    RES      0
         BAL,L1   PID16             WRITE
         CAL1,2   2                 ****  CAL1,2 PLIST                  90
*                                                                       41
         CI,R6    1                 CHECK OPTION
         BLE      BAA02             NOT ACCEPT/STOP
         CI,R6    4
         BE       BAA02             DISPLAY PRINTER
* ACCEPT/STOP - CHECK ECB FOR REPLY
         AI,D3    24                SET DISPL TO ECB
         BAL,L1   PIY32             WRITE
         LW,V2    2                 ****  LW,V2 ECB
         BAL,L1   PIL06             WRITE
         BLZ      X'FFFF'           ****  BLZ  %-1
         CI,R6    3                 IS THIS AN ACCEPT                   COBOL42J
         BNE      BAA02             NO..WE HAVE ENOUGH CODE             COBOL42J
         LW,D3    KMSG              LOAD MSG AREA BASE,DISPL            COBOL42J
         BAL,L1   PID16             WRITE                               COBOL42J
         LB,6     2                 ***LB,6 MSG AREA (ACTUAL SIZE)      COBOL42J
         LW,D3    TEMPX             RECOVER MAX LENGTH OF MSG           COBOL42J
         BAL,L1   PID16             WRITE                               COBOL42J
         CW,6     2                 ***CW,6 MAX LENTH                   COBOL42J
         BAL,L1   PIL06             WRITE                               COBOL42J
         BE       5                 ***BE %+5                           COBOL42J
         BAL,L1   PIA06             WRITE                               COBOL42J
         LI,2     X'40'             ***LI,2 X'40'                       COBOL42J
         LW,D3    KMSG                                                  COBOL42J
         BAL,L1   PID16             WRITE                               COBOL42J
         CB,2     2,6               ***CB,2 MSG AREA,6                  COBOL42J
         BAL,L1   PIL06             WRITE                               COBOL42J
         BLE      2                 ***BGE %+2                          COBOL42J
         LW,D3    KMSG                                                  COBOL42J
         BAL,L1   PID16             WRITE                               COBOL42J
         STB,2    2,6               ***STB,2 MSG AREA,6                 COBOL42J
         B        BAA02             RETURN                              91
*                                                                       92
         TITLE    'PHASE 4.2 - SORT'
* ABN CODES
DFCP     EQU       X'8C'            COMMON PAGE NOT AVAILABLE           COBOL42J
DFSX     EQU       X'8D'            SORT ERROR                          COBOL42J
*
BCD00    RES      0
         BAL,L1   PDB06             WRITE                                1
         GEN,8,24 X'0C',1           ****     M:GCP PLIST                 2
         LBAL     PRA01,CCAL1+X'80' WRITE M:GCP PLIST                    3
* PAGE NOT AVAILABLE TEST                                                4
         BAL,L1   PIL06             WRITE                                5
         BCR,8    4                 ****  BCR,CC1  %+4
         BAL,L1   PIA06             WRITE                                7
         LI,SR1   DFCP              ****     LOAD PAGE NOT AVAILABLE CODE8
         BAL,L1   PIY31             WRITE                                9
         STB,SR1  SR3               ****     STORE ABN CODE             10
         WPOF     ,BA(KABA)+2       WRITE BAL,SR1 C:ABA
* **                     SR2(=RO(=R9)) = WA(CP)                         12
* LOAD SORT PARAMETER REGISTERS                                         13
         LH,D3    5,R2              LOAD BSIZ PARAMETER LIST            23
         LBAL     PIA22,CLI+CRR1    WRITE LI,R1 BSIZ PARAMETER LIST     24
         LBAL,L0  PIZ30,-4,R1       WRITE
         STD,SR2  R6                ****     P1,P2 = WA(CP)             15
         AI,R7    60                ****     P2 = WA(CP)+60(=WA(DCB))   17
* ** DCB SORTIN AT FIXED POSITION ****                                  18
* MOVE SORT PARAMETERS TO COMMON PAGE                                   18
         SLS,SR2  2                 ****     WA(CP) TO BA               20
         STB,R1   SR2               ****     STORE BSIZ
         LH,D3    5,R5              LOAD PARAMETER LIST BASE,DISPL-1    25
         AI,D3    -1                                                    26
         AW,D3    K4BAS                                                 27
         BAL,L1   PID16             WRITE                               28
         MBS,SR1  0                 ****  MBS,SR1 BA(PARAMETER LIST)    29
* **                     SR1(=RE(=R8)) = 1(=NO.OF PAGES)                30
* MOVE DCB SORTIN TO COMMON PAGE                                        31
         BAL,L1   PIA06             WRITE                               32
         LI,R5    0                 ****     CLEAR CP,DCB INDEX         33
         LI,D3    0                 SET SORTIN DCB DISPL = 0            34
         LH,V0    3,R5              LOAD,STORE SORTIN DCB BASE NO.      35
         STH,V0   D3                                                    351
         BAL,L1   PID16             WRITE                               36
         LB,R1    2                 ****  LB,R1  DCB   LOAD DCB WSIZ    37
         BAL,L1   PIY32             WRITE                               38
         LW,R3    2,R5              ****  LW,R3 DCB,R5                  39
         BAL,L1   PIA06             WRITE                               40
         STW,R3   *R7,R5            ****     DCB WORD TO CP             41
         BAL,L1   PIY31             WRITE                               42
         AI,R5    1                 ****     UPDATE CP,DCB INDEX        43
         BAL,L1   PIL06             WRITE                               44
         BDR,R1   X'FFFD'           ****  BDR,R1  %-3                   45
* MOVE DCB OUTSORT TO COMMON PAGE                                       46
         BAL,L1   PIA06             WRITE                               47
         LI,R4    0                 ****     CLEAR DCB INDEX            48
         LH,V0    4,R5              LOAD, STORE OUTSORT DCB BASE NO.    49
         STH,V0   D3                                                    50
         BAL,L1   PID16             WRITE
         LB,R1    2                 ****  LB,R1 WA(DCB)
         BAL,L1   PIY32             WRITE
         LW,R3    2,R4              ****  LW,R3 DCB,R4
         BAL,L1   PIA06             WRITE
         STW,R3   *R7,R5            ****     DCB WORD TO CP
         BAL,L1   PIY31             WRITE
         AI,R4    1                 ****     UPDATE DCB INDEX
         BAL,L1   PIY31             WRITE
         AI,R5    1                 ****     UPDATE CP INDEX
         BAL,L1   PIL06             WRITE
         BDR,R1   X'FFFC'           **** BDR,R1 %-4
*
         LH,R7    2,R2              LOAD OUTSORT DDB OFFSET
         AW,R7    PDBZ+3            SET WA(DDB)
         LW,V1    1,R7              LOAD,CHECK FILE CNTL
* OUTSORT NOT LABELLED
BCD20    RES      0
         BAL,L1   PIA06             WRITE
         STW,R1   *R7,R5            ****     RESET OUTSORT LABEL FLAG
* LINK TO SORT
BCD30    RES      0
         LH,D1    JSORT+1           LOAD,CHECK SORT M:LINK PLIST IND.
         BNEZ     BCD40             NOT= 0(=SORT PLIST ADCON NO.)
* WRITE M:LINK SORT PLIST
         MTW,4    GADNO             ADCON NO. = ADCON NO.+1
         LW,D1    GADNO             LOAD,STORE ADCON NO.
         STH,D1   JSORT+1           STORE WORD ALIGNED BA(PLIST DISPL)
         WPOF     ,BA(JSORT)        WRITE SORT M:LINK PLIST
         AI,D1    16                UPDATE ADCON NO.
         XW,D1    GADNO
*                        D1 = ADCON NO.
BCD40    RES      0
         LBAL     PRA01,CCAL1+X'80' WRITE CAL1,8 SORT M:LINK PLIST
* CHECK SORT RETURN
         BAL,L1   PIA06             WRITE
         CI,R6    0                 ****     CHECK ERROR CODE
         BAL,L1   PIL26             WRITE
         BEZ      4                 ****  BEZ %+4
* SORT ERROR
         BAL,L1   PIA06             WRITE
         LI,SR1   DFSX              ****     LOAD SORT ERROR ABN CODE
         BAL,L1   PIY31             WRITE
         STB,SR1  SR3               ****     STORE SORT ERROR ABN CODE
         WPOF     ,BA(KABA)+2,BAA02 WRITE BAL,SR1 C:ABA
*                                                                       73
         REF      JSXR
JTEXT    EQU      JSXR+10
TEMPX    RES      1                                                     COBOL42J
KODE     GEN,8,8,8,8  1,0,2,0       CODES
         GEN,8,8,8,8  4,0,4,0
         GEN,8,24 1,0
         BOUND    8                                                     81
KTEXT    GEN,8,8,16 8,6,C'AC'
         TEXT     'CEPT'
KPFDT    DATA     X'100'            PRINT FDT 0
         GEN,16,8,8 0,4,C'M'
         DATA     0                 C:  ADCON
         GEN,16,8,8 0,5,C'C'
         REF      JADXC
*
         REF      KABA,K4BAS,K6BAS
K4SPAC   EQU      K4BAS+1
KMSG     EQU      K6BAS+3
         REF      JSORT
         END
