         SYSTEM   SIG7FDP
         PAGE
         OPEN     NAME
         TITLE    'PHASE 1.2'
         REF      SYNTABLE,JUMPTBL,SADGO,NUMBER,PHASEF,SKIP
         REF      RFFFLG,TBLSN2,INTEGER,ENDSOUR,NAME,DBCURT
         REF      DDBAT,DDBATC,WREDF,HASHNUM,DIAG,INTGR,SBW
         REF      COMMA,SADYES,NOSCAN,INTAGER,BYTESNLT,SCAN
         REF      BYTESNWD,STRING,SCANRFF,SADNO,SADNOSN
         REF      POINTLOC,WRIVF,DBCNTR,CONTROL,NONNLIT,SNC
         REF      PICTYOUR,PICTURE,PICINFO,A,CARDNO,SEMICOL
         REF      WRDRF,RDBAD,EXNAME,ACCT,CCT,DCCT,COLAFLG
         REF      PDBL,PDBN,PDBQ,PDBR
         REF      BWZ,PIC                                            BWZ
         REF      PDBTDB,PDBDBG,PDBPL
         REF      FNFF,LENTH
         REF      HLNK12,AHLNK,SADIAG,PDBCC
         REF      FPERD,LIBCPY,REPLC,RNPTR
         REF      SFRPC,SLIBN,WORDR,SNW
         DEF      COB12
         DEF      COB12DB                                               COBOL12
B1       EQU      2
B2       EQU      3
B3       EQU      5
B4       EQU      6
B5       EQU      7
B6       EQU      8
B7       EQU      9
B8       EQU      10
B9       EQU      1
B11      EQU      11
SAD      EQU      SADNO
COB12DB  EQU      %                                                     COBOL12
CLUSTR   RES      67                CLUSTER STORAGE
DADV     DATA     0                 SECTION FLAG
DSDUP    DATA     X'00010002'       DUPLICATION
         DATA     X'00040008'
         DATA     X'00100020'
         DATA     X'00400080'
         DATA     X'01000000'
DSORD    DATA     X'0E0C0800'       ORDER
CLFLG    DATA     0                 CLAUSE FLAG
BB4      DATA     X'08010200'
TDBDN    RES      8                 SAVE DATA NAME FOR TDB
TDBBUF   GEN,32   0                 BUFFER FOR TDB
         GEN,32   0
         GEN,32   0
         GEN,32   0
         GEN,32   0
         GEN,32   0
ODFLG    DATA     0                 OCCURS DEPENDING ON FLAG
ODOF     DATA     0                 ODO COUNT
VALUEK   GEN,32   0                 K FOR VALUE CLUSTER
ALLFLG   GEN,32   0                 'ALL' FLAG
DFLAG    GEN,32   0                 LITERAL FLAG
STB4     GEN,32   0                 SAVE B4
SXEGTF   GEN,32   0                 LEVEL NUMBER FLAG
FDFLG    GEN,32   0                 FILE SECTION FLAG
DBADS    GEN,32   0                 DB ADDRESS FOR DB CLUSTER
REFDB    GEN,32   0                 REFERENCE NUMBER FOR DB CLUSTER
ENDFLI   GEN,32   0                 FLAG FOR'END OF'CLAUSE
FILDBA   GEN,32   0                 SAVE FILE NAME AND BYTE COUNT
DBDREF   GEN,32   0                 SAVE DB NUMBER FOR DRF
STCRDN   GEN,32   0                 SAVE CARDNO
DATANF   GEN,32   0                 DATA NAME FLAG
DRFB     GEN,32   0                 DRF CONTROL BYTE
EIGHTN   DATA     18
FLRF     DATA     0
TEMPF1   DATA     0                                                     COBOL12
FILCL    DATA     X'02230102'                                           COBOL12
VALUE:CNT DATA    50                MAX VLUES IS 50                     COBOL12
         BOUND    8
TALYP    DATA,4   X'042A0005'       CLUSTER FOR TALLY
         DATA,4   X'06000004'
TALYS    DATA,4   X'02220802'
TALYD    DATA     X'00000621'       TALLY NAME
         DATA     X'804D0000',0
OCRDCL   DATA     X'02260002'       OCCUR DEPENDING ON CLUSTER
OCCR1    DATA     X'03240000'       OCCUR CLUSTER X=24
OCCR2    DATA     X'03250000'       OCCUR CLUSTER X=25
SWFIL    DATA     X'02230102'       FILLER
SWSPC    DATA     X'02224002'       SPECIFICATION
SWIVF    DATA     0,X'010C'         IVF CLUSTER
DNCDI    DATA     X'06218001'       DATA-NAME CLUSTER
         DATA     X'30000',0
DNFIL    DATA     X'02230202'       FILLER CLUSTER
FIVFC    DATA     0,X'014004'       IVF CLUSTER
FEVLC    DATA     X'032E0000',0     VALUE CLUSTER
FPICC    DATA     X'032A0001'       PICTURE CLUSTER
         DATA     X'01000000'
DNPIL    DATA     X'032A0006'       PICTURE CLUSTER
         DATA     X'01000000'
DNPIN    DATA     X'032A0084'
         DATA     X'01000000'
         DATA     X'042A0004'
         DATA     X'06000000'
         DATA     X'042A0004'
         DATA     X'06000000'
         DATA     X'042A0004'
         DATA     X'06000000'
         DATA     X'032A001E'
         DATA     X'01000000'
DPINP    DATA     BA(DNPIN+8)       DNPIN POINTER
PICLAS   GEN,8,8,8,8   1,3,6,5      PICTURE CLASS
         GEN,8,24      7,0
OCCVAR   GEN,32   0                 FLAG FOR VARIABLE IN OCCURS
TICTBY   GEN,32   0                 TABLE ITEM CLUSTER CONTROL BYTE
DBNUM    GEN,32   0                 DB NUMBER FOR FILE-NAME IN FD
LABELD   GEN,32   0                 SAVE REFERENCE NUMBER-LABEL
TDBF     GEN,32   0                 TDB CLUSTER OUTPUT FLAG
TDBQF    GEN,32   0                 TDB NUMBER INCREASE FLAG
LBLRF    GEN,32   0                 LABEL RECORD FLAG
DATRCD   GEN,32   0                 DATA RECORD QUALIFIER FLAG
RFFBF    DATA     0                 RFF BACK FLAG
         REF      F:W7                                                  COBOL12
PRCRDSPF GEN,8,24 X'1D',F:W7                                            COBOL12
         GEN,1,31 1,X'10'                                               COBOL12
         GEN,32   1                                                     COBOL12
LBLRECCT DATA     0                 LABEL RECORD COUNT                  COBOL12
LBLRECNM RES      0                 LABEL RECORD REFERENCE NUMBERS      COBOL12
         DO       10                    TEN  ARE ALLOWED                COBOL12
         DATA     0                                                     COBOL12
         FIN                                                            COBOL12
CLBR     GEN,8,24 44,BA(LBLRECCT)                                       COBOL12
PICROT   B        PICAN             BRANCH FOR PICTURE CLUSTER
         B        PICAE
         B        PICND
         B        PICNE
         B        PICND
CLUOUT   LI,B1    SAD
CLUOUT1  STW,4    STB4
         LI,4     BA(CLUSTR)
         BAL,B11  WREDF
         LW,4     STB4
         B        *B1
HCLU     LI,5     0                                                     COBOL12
         STW,5    TEMPF1                                                COBOL12
         CI,3     2                                                     COBOL12
         BNE      %+2               NOT LINKAGE SECTION
         MTB,1    PDBPL             SET LINKAGE SECTION FLAG
         LH,5     DSDUP,3
         AND,5    DADV
         BEZ      SETSF1
         LI,3     13                SECTION DUPLICATED
         B        SADIAG
SETSF1   LH,5     DSDUP,3
         OR,5     DADV
         STW,5    DADV              SET SECTION FLAG
         LB,5     DSORD,3
         AND,5    DADV
         BEZ      HCLU0             GO OUTPUT HEADER CLUSTER
         LI,1     12                SECTION OUT OF ORDER
         BAL,11   DIAG
         B        HCLU0
DBGC     LW,B3    FDFLG
         CI,B3    X'020B'
         BCR,3    DBGC0
         LI,B2    X'020B'           COMMON-STORAGE HEADER
         STH,B2   CLUSTR
         BAL,B1   CLUOUT1
         BAL,10   HCLUC
DBGC0    MTW,0    PDBDBG
         BEZ      SADNO             NO DEBUGGING MODE
         STW,4    STB4              SAVE REGISTER 4
         LI,4     BA(SWFIL)
         BAL,11   WREDF
         LI,4     BA(SWSPC)
         BAL,11   WREDF
         MTW,1    PDBR
         LW,4     PDBR
         AWM,4    FEVLC             SET VALUE SEQ NUMBER
         SLS,4    8
         AI,4     X'C0'
         MTB,5    4
         STW,4    SWIVF
         LI,4     BA(FEVLC)
         BAL,11   WREDF
         LI,4     BA(SWIVF)
         BAL,11   WRIVF
         LI,4     BA(DNCDI)
         BAL,11   WREDF             WRITE TO EDF
         MTW,1    DNCDI
         MTH,3    DNCDI+1
         LI,4     BA(DNCDI)
         BAL,11   WREDF             WRITE TO EDF
         LI,4     BA(DNPIL)
         BAL,11   WREDF             WRITE TO EDF
         LW,4     PDBR
         SLS,4    8
         AI,4     X'B0'
         MTB,4    4                 CLUSTER LENGTH
         STW,4    FIVFC
         LI,2     5
DBGC1    LI,4     BA(DNFIL)
         BAL,11   WREDF             WRITE TO EDF
         MTW,1    FEVLC
         MTW,1    PDBR
         LI,4     BA(FEVLC)
         BAL,11   WREDF             WRITE TO EDF
         LI,4     X'100'            UPDATE VALUE SEQ NUMBER
         AWM,4    FIVFC             UPDATE VALUE SEQ NUMBER
         LI,4     BA(FIVFC)
         BAL,11   WRIVF             WRITE TO IVF
         LI,4     BA(FPICC)
         BAL,11   WREDF             WRITE TO EDF
         MTH,3    DNCDI+1
         LI,4     BA(DNCDI)
         BAL,11   WREDF             WRITE TO EDF
         LW,4     DPINP
         BAL,11   WREDF             WRITE TO EDF
         MTW,-8   DPINP
         BDR,2    DBGC1             NOT FINISHED
         LW,4     STB4              RECOVER REGISTER 4
         B        SADNO
SETCF    LH,5     DSDUP,3           CLAUSE FLAG
         AND,5    CLFLG
         BEZ      SETCF1
         LI,3     18                CLAUSE DUPLICATED
         B        SADIAG
SETCF1   LH,5     DSDUP,3
         OR,5     CLFLG
         STW,5    CLFLG
         B        SAD
TESTFD   LI,5     8                 TEST CLAUSE IN FD
         AND,5    CLFLG
         BNEZ     SADNO
         LI,1     17                REQUIRED CLAUSE MISSING
         BAL,11   DIAG
TESTDA   LI,B3    0
         STW,B3   FLRF
         STW,B3   TDBF
         STW,B3   TDBQF
         STW,B3   CLFLG
         B        SADNO
ALFLG    LI,B2    0                 SET ALLFLG TO ZERO
         B        STALL+1
STALL    LI,B2    1                 ALL FLAG
         STW,B2   ALLFLG
         B        SADNO
SLITF    AI,3     -1                LITERAL
         STW,3    DFLAG
         B        SADNO
EXNAMF   MTB,1    EXNAME            SET NO DNT FLAG
         B        SAD
STPHF4   LI,B3    2                 SET PHASE FLAG
         STW,B3   PHASEF
         LI,B3    0
         B        STPHF6+6
STPHF5   LI,B3    3
         B        STPHF6+3
STPHF6   LI,1     21                MISSING DIVISION DIAG
         BAL,11   DIAG
         LI,B3    -1
         STW,B3   PHASEF
         LI,B3    0
         STW,B3   PDBR              RESET PDBR USED
         STW,B3   PDBQ              RESET PDBQ USED
         B        SAD
*                                                                       COBOL12
* RLBLRF -ISSUES A DIAGNOSTIC IF THE LABEL RECORD COUNT IS NOT ZERO,    COBOL12
*                 INSURES THAT IT IS ZERO.                              COBOL12
RLBLRF   RES      0                                                     COBOL12
         LW,B3    LBLRECCT          IF COUNT ZERO                       COBOL12
         BEZ      SADNO              GET OUT OK                         COBOL12
         LW,1     CLBR                                                  COBOL12
         MBS,0    BA(DADV)                                              COBOL12
RLBLDIAG LI,3     149               DIAGNOSTIC
         B        SADIAG
*                                                                       COBOL12
* LBLRFS--STORES REFERENCE NUMBER FOR CURRENT LABEL NAME IN THE TABLE   COBOL12
*                                                                       COBOL12
LBLRFS   LW,B3    LBLRECCT                                              COBOL12
         CI,B3    10                                                    COBOL12
         BE       RLBLDIAG                                              COBOL12
         LW,B4    HASHNUM                                               COBOL12
         STW,B4   LBLRECNM,B3                                           COBOL12
         MTW,1    LBLRECCT                                              COBOL12
         B        SADNO
GETDN1   RES      0                                                     COBOL12
        LW,B3    LBLRECCT          IF LABEL RECORD(S) TO MATCH UP       COBOL12
        BEZ      GETDN10           NO.                                  COBOL12
        LI,B3    10                YES.                                 COBOL12
        LW,B5    HASHNUM                                                COBOL12
GETDN1A  RES      0
        CW,B5    LBLRECNM-1,B3     IS                                   COBOL12
         BE       GETDN1B              THIS                             COBOL12
         BDR,B3   GETDN1A                 NAME A LABEL
        B        GETDN1C           NO.
GETDN1B  RES      0
        STW,B5   LABELD
        LI,B5    0                 YES REMOVE THE NAME FROM TABLE
         STW,B5   LBLRECNM-1,B3
         MTW,-1   LBLRECCT          DECREMENT THE LABEL COUNT
GETDN1C  RES      0
GETDN10  MTW,0    TDBF                                                  COBOL12
         BCR,1    GETDN11           ODO OR KEY DATA NAME                COBOL12
         LW,B3    CARDNO            FOR TDB CLUSTER
         STW,B3   STCRDN
         LW,B3    HASHNUM
         BCR,1    GETDN11
         LB,B3    BYTESNWD
         STB,B3   TDBDN
         LI,B5    BA(TDBDN)
         AI,B5    1
         STB,B3   B5
         LI,B4    BA(STRING)
         MBS,B4   0
         LI,B3    WA(TDBDN)
         STW,B3   DBADS
GETDN11  LW,B2    DATANF            DATA NAME
         B        GETDNB,B2
GETDN2   LW,B2    DATANF            QUALIFIER
         B        GETQNB,B2
GETSTM1  LW,B2    ODFLG             SUBSCRIPT
         BEZ      GETSTM2
         LI,3     237               DIAGNOSTIC
         B        SADIAG
GETSTM2  LW,B2    DATANF
         CI,B2    1
         BNE      SADNO
         B        DRFS              SUBSCRIPT
GETDNB   B        SADNO             BRANCH TO FORM CLUSTERS
         B        DRFD
         B        REDD
         B        REND
         B        TIMD
         B        DECD
GETQNB   B        SADNO             QUALIFIER
         B        DRFQ
         B        REDQ
         B        RENQ
         B        SADNO
         B        SADNO
ODRFO    LI,B2    X'FC'             DRF-DEPENDING
         STW,B2   DRFB
         MTW,2     OCCVAR                                               COBOL12
         LI,B2    1
         STW,B2   ODFLG             SET FLAG
         STW,B2   DATANF
ODRFO2   MTW,1    TDBF
         MTW,1    PDBTDB            ADD 1 TO TDB COUNT (FOR COBOL21)    COBOL12
         LW,B2    TDBQF
         BCS,3    SADNO
         MTW,1    TDBQF
         MTW,1    PDBQ
         LW,B2    PDBQ
         STB,B2   DBDREF            FOR DRF OUTPUT
         B        SADNO
ODRFD    LI,B2    X'F9'             DRF-DATA RECORD
         STW,B2   DRFB
         LI,B2    1
         STW,B2   DATRCD
         STW,B2   DATANF
         B        SAD
ODRFE    LI,B2    0                 RESET DATANF
         B        ODRFD+4
DRFD     BAL,11   FFBYTD            FORM DRF-DATA NAME
         BAL,11   DRFCM
         BAL,11   MVIJK
         BAL,11   MVCD
         AI,B8    2
DRFD1    SLS,B8   -1
         STB,B8   CLUSTR
         STW,4    STB4
         LI,4     BA(CLUSTR)
         BAL,11   WRDRF             OUTPUT DRF
         LW,4     STB4
         B        SAD
DRFQ     BAL,11   FFBYTS            QUALIFIER
         BAL,11   DRFCM
         BAL,11   MVIJK
         LW,B3    DATRCD
         BCR,3    %+2
         BAL,11   MVCD
         MTW,-2   DATRCD
DRFQ1    AI,B8    2
         B        DRFD1
DRFS     LI,B1    2                 SUBSCRIPT
         LI,B4    X'D1'
         STB,B4   CLUSTR,B1
         LW,B2    INTGR
         STH,B2   CLUSTR+1
         LI,B8    4
         B        DRFD1+1
DRFCM    LW,B5    DBDREF            FIRST WORD OF DRF
         SLD,B4   -8
         LW,B4    DRFB
         SLD,B4   16
         STW,B4   CLUSTR
         B        *11
ODRFQ    LW,B3    DATRCD
         BCS,1    DQFLG
         LI,B4    X'81'             QUALIFIER FOR DATA RECORD
         MTW,0    REFDB
         BGEZ     %+2
         AI,B4    X'10'
         BAL,11   DRFCM
         LI,B3    41
         BAL,11   MVIDB
         BAL,11   MVCD
         MTW,-1   DATRCD
         B        DRFQ1
DQFLG    LI,B3    0                 RESET DATRCD
         STW,B3   DATRCD
         B        SAD
FFBYTD   LI,B4    X'80'             FORM F1, F2 - DATA NAME
FFBYTD1  MTW,0    HASHNUM
         BGEZ     *11
         AI,B4    X'10'
         B        *11
FFBYTS   LI,B4    X'81'             FORM F1, F2 - QUALIFIER
         B        FFBYTD1
MVIJK    LI,B8    6                 IJK OF CLUSTER
         LW,B4    HASHNUM
         STH,B4   CLUSTR+1
         BCR,1    *11
MVIJK1   LB,B4    BYTESNWD          NEGATIVE
         LW,B2    B8
         STB,B4   CLUSTR,B2
         AI,B8    1
         LI,B5    BA(CLUSTR)
         AW,B5    B8
         STB,B4   B5
         AW,B8    B4
         LI,B4    BA(STRING)
         MBS,B4   0
         B        *11
MVCD     LI,B5    BA(CLUSTR)        CD OF CLUSTER
         AW,B5    B8
         LI,B4    4
         STB,B4   B5
         LI,B4    BA(CARDNO)
MVCD1    MBS,B4   0
         AI,B8    4
         B        *11
MVCDB    LI,B5    BA(CLUSTR)        CD OF CLUSTER
         AW,B5    B8
         LI,B4    4
         STB,B4   B5
         LI,B4    BA(STCRDN)
         B        MVCD1
OURED    LI,B2    2                 REDEFINITION CLUSTER
         B        ODRFD+4
OURNA    LI,B2    3                 RENAME CLUSTER
         B        ODRFD+4
REDD     BAL,11   FFBYTD            FORM REDEFINITION CLUSTER
         SLD,B4   -8
         LI,B4    X'2B'
REDD1    SLD,B4   8
         SLS,B4   8
REDD2    STW,B4   CLUSTR
         BAL,11   MVIJK
         AI,B8    2
         SLS,B8   -1
         STB,B8   CLUSTR
         B        CLUOUT
REDQ     BAL,11   FFBYTS            QUALIFIER
         B        REDD+1
REND     BAL,11   FFBYTD            RENAME CLUSTER
         SLD,B4   -8
         LI,B4    X'2D'
         B        REDD1
RENQ     BAL,11   FFBYTS            QUALIFIER
         B        REND+1
OTICLK   LI,B2    4                 TABLE ITEM-KEY
         STW,B2   DATANF
         B        SADNO
TIMD     BAL,11   FFBYTD            FORM TABLE ITEM CLUSTER-KEY
         B        TIMCM
TIMQ     BAL,11   FFBYTS            QUALIFIER
         B        TIMCM
OTICLI   B        TIMD              INDEXED
TIMCM    LW,B5    PDBQ
         SCS,B5   -8
         SLD,B4   -8
         LW,B4    TICTBY
         SLD,B4   16
         B        REDD2
OPDEC    LI,B2    5                 DATA ENTRY CLUSTER
         B        ODRFD+4
DECD     LW,B4    SXEGTF            FORM DATA ENTRY CLUSTER
         SLD,B4   -8
         LW,B8    LABELD
         LI,B4    0
         CW,B8    HASHNUM
         BNE      %+2
         AI,B4    1
         SLD,B4   -4
         LI,B4    X'218'
         MTW,0    HASHNUM
         BGEZ     %+2
         AI,B4    1
         SLD,B4   12
         STW,B4   CLUSTR
         BAL,11   MVIJK
         BAL,11   MVCD
         B        REDD2+2
OFDDB    LI,B4    2                 FORM DDB CLUSTER
         BAL,11   DBCLSTR
         LI,B3    41
         BAL,11   MVIDB
         BAL,11   MVCDB
         LI,B3    40
         BAL,11   MVHEAD
         AI,B8    -28
         LI,B5    BA(CLUSTR)
         AW,B5    B8
         LI,B4    12
         STB,B4   B5
         LI,B4    BA(TDBBUF+1)
         MBS,B4   0
         AI,B8    28
         LW,B5    B8
         AI,B5    -3
         LI,B4    0
         STW,B4   CLFLG             RESET CLAUSE FLAGS                  COBOL12
         LI,B4    7                 PRESET Q OF DDB/SDB TO 7 WORDS      COBOL12
         STB,B4   CLUSTR,B5
         B        MVSTRNG
OSDDB    LI,B4    3                 FORM SDB CLUSTER
         B        OFDDB+1
DBCLSTR  LW,B5    DBDREF            DB CLUSTER HEADER
         SLD,B4   -4
         LI,B4    X'108'
         MTW,0    REFDB
         BGEZ     %+2
         AI,B4    1
         SLD,B4   12
         STW,B4   CLUSTR
         B        *11
MVIDB   LI,B8     6                 IJK OF DB CLUSTER
         LW,B4    REFDB
        STH,B4    CLUSTR+1
         BCR,1    *11
        LI,B5     BA(CLUSTR)
        AW,B5     B8
        LW,B4     DBADS
         SLS,B4   2
         AW,B4    B3
        LB,B1     0,B4
        AI,B1     1
        AW,B8     B1
        STB,B1    B5
        MBS,B4    0
        B         *11
MVHEAD   LI,B5    BA(CLUSTR)        MOVE FIXED PART OF DB BLOCK
         AW,B5    B8
         AWM,B3   PDBN
         AW,B8    B3
         STB,B3   B5
         LW,B4    DBADS
         SLS,B4   2
         STW,B4   DBADS
         LB,B1    0,B4
         CI,B1    0                 CHECK DUPLICATION
         BCS,3    MVHEAD1
         LI,3     199               DIAGNOSTIC
         B        SADIAG
MVHEAD1  MBS,B4   0
         LW,B4    DBADS
         LI,B1    0                 SET FOR LATER TEST
         STB,B1   0,B4
         AWM,B3   DBADS
         B        *11
MVSTRNG  LI,B5    BA(CLUSTR)        MOVE NAME PART OF DB
         AW,B5    B8
         LW,B1    DBADS
         AI,B1    1
         LB,B4    0,B1
         AI,B4    5                 ADJUST LENGTH TO WORD FOR OUTPUT    COBOL12
         AND,B4   L(X'FFFFFFFC')    AND BUILDING DDB IN COBOL21         COBOL12
         AWM,B4   PDBN
         AW,B8    B4
         STB,B4   B5
         LW,B4    DBADS
         MBS,B4   0
         MTW,1    PDBL
         B        REDD2+2
DDBFRM   BAL,11   CKFNFF
         LB,B5    BYTESNWD          FORM DDB
         AI,B5    -2
         BCR,2    %+4
         MTW,-1   DBCURT
         AI,B5    -4
         BCS,2    %-2
         LW,B2    DBCURT
         MTW,1    DDBATC
         LW,B3    DDBATC
         STW,B2   DDBAT-1,B3        SAVE  DDB ADDRESS
         MTW,1    DBCNTR
         LW,B4    DBCNTR
         LW,B5    BYTESNWD
         SLD,B4   24
         STW,B4   *B2
         LW,B5    B2
         SLS,B5   10
         LB,B4    BYTESNWD
         SLD,B4   -8
         AI,B5    2
         LI,B4    BA(STRING)
         MBS,B4   0                 MOVE FILE-NAME IN DB
         LI,B4    0
         LI,B5    -9
         STW,B4   -1,B2
         AI,B2    -1
         BIR,B5   %-2
         AI,B2    -1
         STW,B2   DBCURT
*
* SET FIELDS A AND D OF DDB
* FIELD D (NUMBER OF INSN/OUTSN'S) IS SET TO 3
*
         LW,B2    L(X'01000083')    COMPILER DEFAULT                    COBOL12
         STW,B2   *DBCURT
         MTW,-1   DBCURT
         B        *B1
SVFLN    LW,B2    DDBATC            CHECK DDB FORMED
         BCS,3    SVFLN1
         LI,B2    0
         STW,B2   FILDBA
         B        *B1
SVFLN1   LI,B5    BA(STRING)
         LB,B4    BYTESNWD
         STB,B4   B5
         LW,B4    DDBAT-1,B2
         LW,8     L(X'00FF0000')
         AND,8    0,6
         SLS,8    -16
         CB,8     BYTESNWD
         BCS,3    %+4
         SLS,B4   2
         CBS,B4   2
         BCR,3    %+3
         BDR,B2   SVFLN1
         B        SVFLN+2
         LW,B5    DDBAT-1,B2
         AI,B5    -10
         STW,B5   FILDBA
         B        *B1
TESTIX   LI,B3    X'29'
         STW,B3   TICTBY            STORE CONTROL BYTE-INDEXED
         B        ODRFO2
BDDB     LB,B3    BB4,3             SET B OF DDB
         SLS,B3   16
         EOR,B3   *FILDBA
         STW,B3   *FILDBA
         B        SAD
GHDDB    LW,B3    INTGR             SET G, H OF DDB
         STH,B3   *FILDBA,3
         B        SADNO
SPCL     CI,3     2                 USAGE
         BNE      %+2
         STW,3    BWZ               BLANK WHEN ZERO
         LW,B4    SWSPC             SPECIFICATION CLUSTER
         STW,B4   CLUSTR
         LI,5     2
         STB,3    CLUSTR,5          SET USAGE BYTE
         B        CLUOUT
STASK    LI,B3    X'27'             STORE CONTROL BYRE-ASCENDING
         LI,B2    X'20'             ASCENDING
         B        STDEK1
STDEK    LI,B3    X'28'             STORE CONTROL BYTE-DESCENDING
         LI,B2    X'10'             DESCENDING
STDEK1   STW,B3   TICTBY
         OR,B2    OCCVAR
         STW,B2   OCCVAR
         CI,B2    1
         BANZ     %+2
         MTW,1    OCCVAR
         LI,B2    4
         B        ODRFO2-1                                              COBOL12
ODRFR    LW,B2    RDBAD
         BCR,3    ODRFR2            GO TO FORM NEW RDB
         LB,B4    BYTESNWD
         LI,B5    BA(STRING)
         STB,B4   B5
         LW,B4    RDBAD,B2
         LW,8     L(X'00FF0000')
         AND,8    3,6
         SLS,8    -16
         CB,8     BYTESNWD
         BCS,3    %+4
         SLS,B4   2
         CBS,B4   14
         BCR,3    %+3
         BDR,B2   ODRFR+2
         B        ODRFR2            GO TO FORM NEW RDB
         LW,B4    DBNUM             FIND SAME DDB NUMBER IN RDB
         LW,B5    RDBAD,B2
         SLS,B5   2
         LI,B2    4
         AI,B5    1
         CB,B4    0,B5
         BCR,3    ODRFR1            FIND SAME DDB NUMBER
         BDR,B2   %+2
         B        ODRFR3
         LB,B1    0,B5
         BCS,2    %-6
         STB,B4   0,B5
ODRFR1   LI,B2    X'FA'             OUTPUT DRF FOR REPORT
         STW,B2   DRFB
         B        DRFD
ODRFR2   BAL,11   CKFNFF
         LB,B4    BYTESNWD          FORM NEW RDB
         AI,B4    -2
         BCR,2    %+4
         MTW,-1   DBCURT
         AI,B4    -4
         BCS,2    %-2
         MTW,1    DBCNTR
         LW,B4    DBCNTR
         LW,B5    BYTESNWD
         SLD,B4   8
         STH,B4   *DBCURT
         LW,B5    DBCURT
         SLS,B5   2
         AI,B5    2
         STB,B4   B5
         LI,B4    BA(STRING)
         MBS,B4   0
         LW,B3    DBCURT
         LI,B4    0
         STW,B4   -1,B3
         STW,B4   -2,B3
         LW,B5    DBDREF
         LI,B4    5
         SLD,B4   8
         SLS,B4   16
         STW,B4   -3,B3
         MTW,1    RDBAD             UPDATE RDBAD
         LW,B2    RDBAD
         AI,B3    -3
         STW,B3   RDBAD,B2
         AI,B3    -1
         STW,B3   DBCURT
         B        ODRFR1
ODRFR3   LI,3     205               DIAGNOSTIC
         B        SADIAG
CKFNFF   LW,B3    FNFF
         BCS,3    CKFNFF1
         LW,B5    LENTH
         LI,B4    0
         AI,B5    -50
         DW,B4    EIGHTN
         SW,B5    DBCNTR
         BCS,2    *11
         LI,1     289               ISSUE DIAG 289                     COBOL12
         BAL,B11  DIAG                                                 COBOL12
         B        SAD
CKFNFF1  LI,B3    0
         STB,B3   NOSCAN
         BAL,11   SCAN
         LI,B3    C'.'
         CB,B3    STRING
         BCS,3    CKFNFF1
         LI,3     34                DIAGNOSTIC
         B        SADIAG
STLVL    LI,B4    0
         STW,B4   COLAFLG
         LB,B5    EXNAME
         BCS,3    SAD
         LW,B3    INTGR             CHECK LEVEL NUMBER
         STW,B3   SXEGTF
         BCR,2    STLVL1
         CI,B3    1
         BNE      STLVL2                                                COBOL12
         STW,6    ODOF                                                  COBOL12
         MTW,1    TEMPF1                                                COBOL12
         B        SADNO                                                 COBOL12
STLVL2   CI,5     X'4D'             LEVEL 77                            COBOL12
         BE       TESTSV                                                COBOL12
         CI,5     X'32'             LEVEL 50                            COBOL12
         BL       STLVL3                                                COBOL12
         CI,5     X'42'             LEVEL 66                            COBOL12
         BNE      STLVL4                                                COBOL12
STLVL3   MTW,0    TEMPF1                                                COBOL12
         BNE      SADNO                                                 COBOL12
         MTW,1    TEMPF1                                                COBOL12
         STW,4    STB4              SAVE REG 4                          COBOL12
         LI,4     BA(FILCL)         CLUSTER ADDRESS                     COBOL12
         BAL,11   WREDF             OUTPUT TO EDF                       COBOL12
         LW,4     STB4              RECOVER REG 4                       COBOL12
         LI,3     X'64'             DIAG NUMBER                         COBOL12
         B        SADIAG                                                COBOL12
STLVL4   CI,5     X'58'             LEVEL 88                            COBOL12
         BE       SADNO                                                 COBOL12
STLVL1   RES      0                                                     COBOL12
         LI,1     35                DIAG NUMBER                         COBOL12
         BAL,B11  DIAG              ISSUE DIAG                          COBOL12
*        THE FOLLOWING TWO INST ARE ONLY NECESSARY TO
*        MINIMIZE THE DIAGNOSTIC OUTPUT PRODUCED
         LI,1     1                 LEVEL NUM                           COBOL12
         STW,1    SXEGTF                                                COBOL12
         B        SNC               BYPASS REST OF CARD                 COBOL12
TSTSX    LW,B3    SXEGTF            TEST AGAINST 66
         AI,B3    -66
         BCR,3    SAD
         B        STLVL1
EGTEGT   RES      0                                                     COBOL12
         LI,B3    50                ALLOW 50 LITERALS ONLY              COBOL12
         STW,B3   VALUE:CNT          ON 88 ITEM                         COBOL12
         LW,B3    SXEGTF            TEST AGAINST 88                     COBOL12
         AI,B3    -88
         BCR,3    SADYES
         B        SADNO
CKFILE   LW,B3    FDFLG             CHECK FILE SECTION FLAG
         CI,B3    X'0208'
         BCS,3    SADNO
         B        SADYES
TESTSV   LW,B2    FDFLG             77 IN FD ?
         CI,B2    X'0208'
         BCR,3    STLVL1
         B        SAD
SDDDB    BAL,B1   SVFLN             CHECK DDB FORMED
         LW,B2    FILDBA
         BCS,3    SDDDB1
         BAL,B1   DDBFRM
         LI,B9    34
         BAL,11   DIAG
         LW,B2    DBCURT
         AI,B2    1
SDDDB1   LI,B3    2
         STB,B3   *B2               CHANGE CONTROL BYTE TO 02
         LW,B3    RFFBF
         BCS,3    STFLN1
         B        STFLN1-3
OVALCD   RES      0                                                     COBOL12
         MTW,0    VALUE:CNT         SHOULD WE OUTPUT LITERAL            COBOL12
         BLEZ     SAD               BRANCH IF LIMIT EXCEEDED            COBOL12
OVALCD1  RES      0                                                     COBOL12
         STW,4    STB4              SAVE B4                             COBOL12
         LI,4     BA(CLUSTR)
         BAL,B11  WRIVF
         LW,4     STB4
         MTW,1    VALUEK
         B        SAD
OVALCS   LI,B3    1                 RESET E TO 1
         STB,B3   CLUSTR+1                                              COBOL12
         B        OVALCD            GO OUTPUT IT                        COBOL12
OVALCZ   LI,B3    0                 RESET E TO 0
         STB,B3   CLUSTR+1
         B        OVALCD1           ALWAYS OUTPUT LAST CLUSTER          COBOL12
OIVFL    RES      0                                                     COBOL12
         MTW,-1   VALUE:CNT         HAVE WE EXCEEDED MAXIMUM            COBOL12
         BGEZ     OIVFL0            BRANCH IF NOT                       COBOL12
         LI,1     -1                SEE IF NEED TO ISSUE DIAG           COBOL12
         CW,1     VALUE:CNT         ON TIME ONLY                        COBOL12
         BNE      SAD               BRANCH IF NOT FIRST TIME            COBOL12
         LI,1     290               ISSUE DIAG                          COBOL12
         BAL,11   DIAG                                                  COBOL12
         B        SAD                                                   COBOL12
OIVFL0   RES      0                                                     COBOL12
         LW,B3    DFLAG             FORM IVF                            COBOL12
         BCS,1    OIVFL1            GO TO FORM NUMERIC
         AI,B3    -5
         BCR,3    OIVFL2            GO TO FORM LITERAL STRING
         LW,B4    DFLAG
         SLD,B4   -4
         LI,B4    3
         B        OIVFL2+3
OIVFL1   LI,B4    0
         SLD,B4   -4
         LI,B4    X'C'
         B        OIVFL2+3
OIVFL2   LW,B4    ALLFLG
         SLD,B4   -4
         LI,B4    X'B'
         SLD,B4   -4
         LW,B4    PDBR
         SLD,B4   8
         STW,B4   CLUSTR
         LI,B4    2
         LW,B3    DFLAG
         BCS,1    OIVFL3            GO TO FORM F FOR NUMERIC
         AI,B3    -5
         BCR,3    OIVFL4            GO TO FORM F FOR STRING
         STB,B4   CLUSTR+1
         LI,B2    3
         B        OIVFL5+2
OIVFL3   LW,B5    POINTLOC
         SLS,B5   24
         SLD,B4   8
         LW,B5    BYTESNLT
         SLD,B4   16
         STW,B4   CLUSTR+1
         LI,B5    BA(CLUSTR)
         AI,B5    7
         LB,B4    BYTESNLT
         STB,B4   B5
         LI,B4    BA(INTAGER)
         MBS,B4   0
         LB,B2    BYTESNLT
         AI,B2    7
         B        OIVFL5
OIVFL4   LW,B5    BYTESNWD
         SLD,B4   8
         STH,B4   CLUSTR+1
         LI,B5    BA(CLUSTR+1)
         AI,B5    2
         STB,B4   B5
         LI,B4    BA(STRING)
         MBS,B4   0
         LB,B2    BYTESNWD
         AI,B2    6
OIVFL5   AI,B2    2
         SLS,B2   -1
         STB,B2   CLUSTR
         B        SAD
HCLU0    CI,3     0                 HEADER CLUSTER
         BNE      HCLU1
         STW,3    RDBAD
HCLU1    AI,B2    X'208'            HEADER CONTROL BYTE
         STW,B2   FDFLG
         STH,B2   CLUSTR
         LW,6     CARDNO
         STH,6    CLUSTR+2
         SLS,6    -16
         STW,6    CLUSTR+1
         BAL,B1   CLUOUT1
         CI,B2    X'20B'            CHECK COMMON-STORAGE
         BCS,3    SAD
         BAL,10   HCLUC
         B        SADNO
HCLUC    STW,4    STB4              OUTPUT CLUSTERS FOR TALLY
         LW,B4    CARDNO
         STW,B4   TALYD+2           CARD NO.
         LI,4     BA(TALYD)+2       TALLY - NAME
         BAL,11   WREDF
         LI,4     BA(TALYP)         PICTURE
         BAL,11   WREDF
         LI,4     BA(TALYS)         SPECIFICATION
         BAL,11   WREDF
         LW,4     STB4
         B        *10
SKTDB1   LW,B4    TDBF              FORM TDB CLUSTER
         BCR,3    SADNO
         LW,B4    PDBQ
         SLD,B4   -8
         LI,B4    5
         BAL,11   DBCLSTR+1
         LI,B3    0
         BAL,11   MVIDB
         BAL,11   MVCDB
         LW,B4    OCCVAR
         STB,B4   TDBBUF
         CI,B4    7
         BCS,2    %+3
         LI,B3    8
         B        %+2
         LI,B3    24
         LI,B4    WA(TDBBUF)
         STW,B4   DBADS
         BAL,11   MVHEAD
         B        REDD2+2
OUFLR    LW,B3    FLRF
         BCS,3    SADNO
         LW,B3    SXEGTF
         BCR,2    STLVL1
         MTW,1    FLRF
         AI,B3    -49
         BCR,2    OUFLR1
         AI,B3    -28
         BCR,3    OUFLR1
         LI,B9    35
         BAL,B11  DIAG
OUFLR1   RES      0
         LW,B4    DNFIL             FILLER CLUSTER
         STW,B4   CLUSTR
         LW,B3    SXEGTF
         LI,B2    2
         STB,B3   CLUSTR,B2
         LI,B3    X'FFFF'
         STW,B3   REFDB
         B        CLUOUT
OUNNA    LI,B3    X'022C'           REDEFI CLUSTER-NAMELESS
         STH,B3   CLUSTR
         B        CLUOUT
VALOCS   MTW,1    PDBR              UPDATE VALUE COUNTER
         LI,B3    0
         STW,B3   VALUEK
         LW,3     FDFLG
         CI,3     X'20A'
         BNE      SADNO             NOT LINKAGE SECTION
         LI,3     88
         CW,3     SXEGTF
         BE       SADNO             LEVEL 88
         LI,3     206
         B        SADIAG
OVALC    LW,B4    FEVLC             VALUE CLUSTER
         AW,B4    PDBR
         STW,B4   CLUSTR
         LW,B3    VALUEK
         STB,B3   CLUSTR+1
         B        CLUOUT
OOCC1    LW,B4    OCCR1             OCCUR CLUSTER - FROM
         B        OOCC3
OOCC2    LW,B4    OCCR2             OCCUR CLUSTER - TO
OOCC3    LI,B3    6
         STW,B3   OCCVAR
         OR,B4    INTGR
         STW,B4   CLUSTR
         B        CLUOUT
OODPC    LW,B3    OCRDCL            FORM OCCUR DEPENDING CLUSTER
         STW,B3   CLUSTR
         LW,B3    PDBQ
         LI,B2    2
         STB,B3   CLUSTR,B2
         BAL,B1   CLUOUT1
         MTW,1    ODOF              UPDATE ODO COUNT
         LI,B3    0
         STW,B3   ODFLG             RESET ODFLG
         LW,B3    ODOF
         CI,B3    15
         BLE      SAD
         LI,3     238               ODO LIMIT EXCEEDED
         B        SADIAG
SPICF    LI,B2    1                 SET FLAG IN PICTYOUR
         STB,B2   PICTYOUR
         BAL,B11  SCAN
         LI,3     1
         B        SETCF
OFRRO    LI,B2    0                 RESET RFFFLG
         STW,B2   RFFFLG
         B        SAD
RTRFF    LW,B4    DDBATC            CHECK MOVING RFF BACK OR NOT
         BCR,3    SADNO
         LW,B2    DDBAT-1,B4
         LW,B6    -7,B2
         BCS,3    %+3
RTRFF1   BDR,B4   %-3
         B        RTRFF3
         LW,B5    DDBATC
         LW,B1    DDBAT-1,B5
         CW,B6    -6,B1
         BCR,3    %+3
RTRFF2   BDR,B5   %-3
         B        RTRFF1
         LI,B3    0
         STW,B3   -6,B1
         AI,B3    1
         STW,B3   -7,B1
         STW,B3   RFFBF
         AI,B1    -10
         STW,B1   FILDBA
         STW,B6   RFFFLG
         BAL,B11  SCANRFF           REMOVE RFF BACK
         LW,B2    FILDBA
         LW,B3    10,B2
         STW,B3   DBDREF
         SLS,B3   -24
         STW,B3   DBNUM
         STW,B2   DBADS
         LW,B3    5,B2
         STW,B3   REFDB
         BAL,11   SCAN
         LI,B3    1
         STB,B3   NOSCAN
         LW,B5    CARDNO
         STW,B5   STCRDN
         B        SADYES
RTRFF3   LW,B5    DDBATC            CHECK FILE NAME WITHOUT FD OR SD
         BCR,3    SADNO
*        CAL1,1   PRCRDSPF          BACK UP THE SPF ONE RECORD          COBOL12
         LW,B1    DDBAT-1,B5
         AI,B1    -10
         SLS,B1   2
         LB,B2    0,B1
         BCR,3    RTRFF4
         SLS,B1   -2
         LW,B2    3,B1
         BCS,3    RTRFF4
         LI,3     198               DIAGNOSTIC
         B        SADIAG
RTRFF4   BDR,B5   RTRFF3+2
         B        SADNO
SPFOFF   RES      0                                                     COBOL12
         LW,B4    PDBCC                                                 COBOL12
         AND,B4   =X'FFFF7FFF'                                          COBOL12
         CW,B4    PDBCC                                                 COBOL12
         BE       SADNO             LS OPTION ACTIVE   NO. GET OUT      COBOL12
         XW,B4    PDBCC             YES. SAVE CURRENT OPTIONS           COBOL12
         STW,B4   PDBCCSV           DELETE LS OPTION                    COBOL12
         B        SADNO                                                 COBOL12
SPFBACK  RES      0                                                     COBOL12
         LW,B4    PDBCCSV           OPTIONS SAVED                       COBOL12
         BEZ      SADNO             NO. GET OUT                         COBOL12
         STW,B4   PDBCC             YES RESTORE  'EM                    COBOL12
         B        SADNO                                                 COBOL12
PDBCCSV  DATA     0                                                     COBOL12
STFLN    BAL,B1   SVFLN             CHECK THE DB BLOCK
         LW,B2    FILDBA
         BCR,3    STFLN2
         LW,B4    3,B2
         BCR,3    %+2
         STW,B4   RFFFLG            FOR RENAMED FILE
STFLN1   LW,B3    10,B2
         STW,B3   DBDREF            SAVE FOR CLUSTER OUTPUT
         SLS,B3   -24
         STW,B3   DBNUM
         STW,B2   DBADS
         LW,B3    HASHNUM
         STW,B3   REFDB
         LW,B5    CARDNO
         STW,B5   STCRDN
         B        SAD
STFLN2   BAL,B1   DDBFRM            DUMMY FILE NAME
         LI,B9    34
         BAL,B11  DIAG
         LW,B2    DBCURT
         AI,B2    1
         B        STFLN1
CALPIC   LW,B3    PIC                                                BWZ
         BCR,3    SADNO                                              BWZ
         LI,B3    0                                                  BWZ
         STW,B3   PIC                                                BWZ
         BAL,B9   PICTURE                                            BWZ
         LW,B3    PICINFO           FORM PICTURE CLUSTER
         LI,B2    BA(PICLAS)
         LI,B1    5
         AI,B2    4
         LB,B4    0,B2
         SW,B4    B3
         BCR,3    %+4
         AI,B2    -1
         BDR,B1   %-4
         B        SAD
         LW,B4    PICINFO+1
         SLD,B4   -16
         LI,B4    X'2A'
         SLD,B4   16
         STW,B4   CLUSTR
         EXU      PICROT-1,B1
PICAN    LI,B4    3                 FORM PICTURE CLUSTER-AN
         STB,B4   CLUSTR
         STB,B3   CLUSTR+1
         B        CLUOUT
PICND    LI,B4    4                 FORM PICTURE CLUSTER-ND,NDU
         STB,B4   CLUSTR
         LW,B4    PICINFO+2
         SLD,B4   -16
         LW,B4    B3
         SLD,B4   24
         STW,B4   CLUSTR+1
         LI,B4    31                MAX SIZE FOR NUMERIC                COBOL12
         CW,B4    PICINFO+1         COMPARE WITH SIZE OF ENTRY          COBOL12
         BGE      CLUOUT            SIZE O.K.                           COBOL12
         STW,B4   PICINFO+1         CHANGE IN PIC INFO                  COBOL12
         LI,B1    1                                                     COBOL12
         STH,B4   CLUSTR,B1         CHG IN CLUSTER                      COBOL12
         LI,B9    -225              > 31 DIGITS ILLEGAL                 COBOL12
         BAL,B11  DIAG              ISSUE DIAG THEN WRITE CLUSTER       COBOL12
         B        CLUOUT
PICAE    LI,B1    7                 FORM PICTURE CLUSTER-AE
         LW,B4    PICINFO+2
         SLD,B4   -16
         LI,B4    3
         SLD,B4   24
         STW,B4   CLUSTR+1
         LI,B5    BA(CLUSTR)
         AW,B5    B1
         LB,B4    PICINFO+3
         AI,B4    1
         AW,B1    B4
         STB,B4   B5
         LI,B4    BA(PICINFO+3)
         MBS,B4   0                 MOVE MASK DISCRIPTOR
PICAE1   LI,B5    BA(CLUSTR)
         AW,B5    B1
         LW,B4    PICINFO+1
         AW,B1    B4
         STB,B4   B5
         LI,B4    BA(PICINFO+11)
         MBS,B4   0                 MOVE EDITING MASK
         AI,B1    2
         SLS,B1   -1
         STB,B1   CLUSTR
         B        CLUOUT
PICNE    LI,B1    13                FORM PICTURE CLUSTER-NE
         LW,B4    PICINFO+4
         SLD,B4   -4
         LW,B4    PICINFO+3
         SLD,B4   -2
         SLS,B4   -14
         SLD,B4   -2
         LW,B4    PICINFO+2
         SLD,B4   -16
         LI,B4    5
         SLD,B4   24
         STW,B4   CLUSTR+1
         LW,B4    PICINFO+10
         SLD,B4   -8
         LW,B4    PICINFO+8
         SLD,B4   -8
         LW,B4    PICINFO+7
         SLD,B4   -8
         LW,B4    PICINFO+6
         SLD,B4   -6
         LW,B4    PICINFO+9
         SLD,B4   -2
         STW,B5   CLUSTR+2
         LW,B4    PICINFO+5
         STB,B4   CLUSTR+3
         B        PICAE1
**********************************************************************  COBOL12
*                                                                       COBOL12
*   XRECDS  CHECK FOR WORD 'RECORDS' IN BLOCK CONTAINS CLAUSE           COBOL12
*                                                                       COBOL12
RECDSLIT TEXT     C'RECORDS '       8-BYTE LITERAL TO TEST VS. STRING   COBOL12
DESTREG  GEN,8,24  8,BA(STRING)     COUNT AND DESTINATION ADDR FOR CBS  COBOL12
         SPACE    2                                                     COBOL12
XRECDS   BAL,B11  SCAN              SKIP OVER PREVIOUS RESERVED WORD    COBOL12
         LW,B5    DESTREG           SET UP R|1 WITH COUNT AND DEST ADDR COBOL12
         LI,B4    BA(RECDSLIT)      SET UP R WITH SOURCE ADDRESS        COBOL12
         CBS,B4   0                 COMPARE                             COBOL12
         BE       SADYES            IF MATCH, GO TO NEXT DBLWD FOR YES  COBOL12
         B        SADNOSN                                               COBOL12
EXNAM2   RES      0
         LW,B3    INTGR
         CW,B3    SXEGTF
         BE       SADYES
         B        SADNO
COB12    LI,B2    WA(TBLSN2)        PHASE 1.2 INITIALIZATION
         STW,B2   SYNTABLE
         LI,B2    TBLJMP
         STW,B2   JUMPTBL
         LI,B2    HLNK12
         STW,B2   AHLNK
         LI,4     50                SET PDBQ TO 50 IN CASE ENVIRONMENT  COBOL12
         STW,4    PDBQ              DIVISION WAS NOT PRESENT            COBOL12
         LI,4     0
         B        SADGO
TBLJMP   EQU      %
         B          BDDB                                                00000000
         B          GHDDB                                               00000001
         B          HCLU                                                00000002
         B          SETCF                                               00000003
         B          SLITF                                               00000004
         B          SPCL                                                00000005
         B          A                                                   00000006
         B          ACCT                                                00000007
         B          ALFLG                                               00000008
         B          CALPIC                                              00000009
         B          CCT                                                 00000010
         B          CKFILE                                              00000011
         B          COMMA                                               00000012
         B          DBGC                                                00000013
         B          DCCT                                                00000014
         B          DQFLG                                               00000015
         B          EGTEGT                                              00000016
         B          ENDSOUR                                             00000017
         B          EXNAMF                                              00000018
         B          EXNAM2                                              00000019
         B          FPERD                                               00000020
         B          GETDN1                                              00000021
         B          GETDN2                                              00000022
         B          GETSTM1                                             00000023
         B          INTEGER                                             00000024
         B          LBLRFS                                              00000025
         B          LIBCPY                                              00000026
         B          NAME                                                00000027
         B          NONNLIT                                             00000028
         B          NUMBER                                              00000029
         B          ODRFD                                               00000030
         B          ODRFE                                               00000031
         B          ODRFO                                               00000032
         B          ODRFQ                                               00000033
         B          ODRFR                                               00000034
         B          OFDDB                                               00000035
         B          OFRRO                                               00000036
         B          OIVFL                                               00000037
         B          OOCC1                                               00000038
         B          OOCC2                                               00000039
         B          OODPC                                               00000040
         B          OPDEC                                               00000041
         B          OSDDB                                               00000042
         B          OTICLI                                              00000043
         B          OTICLK                                              00000044
         B          OUFLR                                               00000045
         B          OUNNA                                               00000046
         B          OURED                                               00000047
         B          OURNA                                               00000048
         B          OVALC                                               00000049
         B          OVALCD                                              00000050
         B          OVALCS                                              00000051
         B          OVALCZ                                              00000052
         B          REPLC                                               00000053
         B          RLBLRF                                              00000054
         B          RNPTR                                               00000055
         B          RTRFF                                               00000056
         B          SBW                                                 00000057
         B          SDDDB                                               00000058
         B          SEMICOL                                             00000059
         B          SFRPC                                               00000060
         B          SKTDB1                                              00000061
         B          SLIBN                                               00000062
         B          SNC                                                 00000063
         B          SNW                                                 00000064
         B          SPFBACK                                             00000065
         B          SPFOFF                                              00000066
         B          SPICF                                               00000067
         B          STALL                                               00000068
         B          STASK                                               00000069
         B          STDEK                                               00000070
         B          STFLN                                               00000071
         B          STLVL                                               00000072
         B          STPHF4                                              00000073
         B          STPHF5                                              00000074
         B          STPHF6                                              00000075
         B          TESTDA                                              00000076
         B          TESTFD                                              00000077
         B          TESTIX                                              00000078
         B          TSTSX                                               00000079
         B          VALOCS                                              00000080
         B          WORDR                                               00000081
         B          XRECDS                                              00000082
         END
