         SYSTEM   SIG7FDP
         PAGE
         OPEN     NAME
         TITLE    'PHASE 1.3'
         REF      NAME,NONNLIT,NUMBER,SBW,SEMICOL,SNC,POINTLOC
         REF      SADYES,SADNO,DIAG,WREDF,WRRRF,WRIVF,SKIP,CCT
         REF      HASHNUM,PICTYOUR,CARDNO,BYTESNWD,STRING,HASH
         REF      NOSCAN,INTAGER,INTGR,PICTURE,PICINFO
         REF      FPERD,LIBCPY,REPLC,RNPTR
         REF      SFRPC,SLIBN,WORDR
         REF      A,ACCT,COMMA,DCCT,ENDSOUR,INTEGER,SNW,PHASEF
         REF      SADGO,SYNTABLE,JUMPTBL,TBLSN3,BYTESNLT,SCAN
         REF      RDBAD,EXNAME,COLAFLG,DBCNTR,PDBP,PDBR,PDBL
         REF      PDBN
         REF      BWZ,PIC                                            BWZ
         REF      SVRPF                                                 COBOL13
         DEF      COB13
         DEF      COB13DB           ALLOW FOR MODIFY AND SNAP           COBOL13
B1       EQU      1
B2       EQU      2
B3       EQU      3
B5       EQU      5
B6       EQU      6
B7       EQU      7
B8       EQU      8
B9       EQU      9
B11      EQU      11
SAD      EQU      SADNO
COB13DB  RES      0                 FOR DEBUGGING PURPOSES              COBOL13
DDBAT    RES      67                SAVE PICTURE CLUSTER
RDBST    RES      11                RDB, DUMMY
CLSTOR   RES      66               CLUSTER BUFFER
VACLSV   RES      2                 VALUE CLUSTER
STB4     RES      1                 SAVE CONTENT OF REGISTER 4
ALLFLG   GEN,32   0                 'ALL' FLAG
DFLAG    GEN,32   0                 LITERAL FLAG
FLGSTF   GEN,32   0                 PREVIOUS ELEMENTARY LINE FLAG
HISTORY  GEN,32   0                 HISTORY
RGRN1    GEN,32   0                 REPORT GROUP REF - POS
RGRN2    GEN,32   0                 REPORT GROUP REF - NEG
LEVELN   GEN,32   0                 SAVE LEVEL NUMBER
SSLECT   GEN,32   0                 CHECK FOR SOURCE-SELECTED
LINEF    GEN,32   0                 LINE CLAUSE FLAG
FIRLF    GEN,32   0                 FIRST LINE FLAG
GNAMF    GEN,32   0                 GROUP NAME FLAG
HSTOR    GEN,32   0                 SAVE H OF SYNTAX ONLY CLUSTER
DATANC   GEN,32   0                 DATA-NAME NUMBER IN CONTROL CLAUSE
FINALF   GEN,32   0                 CONTROL CLAUSE FLAG-FINAL
IDXIDF   GEN,32   0                 INDEX FLAG
DASBS    GEN,32   0                 FLAG FOR IDENTIF
DCONTRL  GEN,32   0                 OUTPUT CONTROL FOR DATA-NAME
GROREL   GEN,32   0                 GROUP OR ELEMENTARY FLAG
ROCPF    GEN,32   0                 BRANCH FLAG FOR TYPE
SYNNO    GEN,32   1                 SAVE FOR SYNTAX ONLY CLUSTER
CKOTLF   GEN,32   0                 SUPRESS DIAGNOSTICS FLAG
VALFLG   GEN,32    0                VALUE FLAG--TEST FOR GOOD LITERAL   COBOL13
RD01F    DATA     0                 REPORT RECORD FLAG                  COBOL13
NRHF     DATA     4
NPOF     DATA     X'02060105'
SYNCCL   GEN,8,8,4,12  5,X'78',0,X'17'  SYNCHRONIZATION
REPTCL   GEN,16,8,8    0,3,X'30'    REPORT SPECIFICATION CLUSTER
VALUCL   GEN,16,8,8    0,3,X'2E'    VALUE CLUSTER
SYOLYC   GEN,8,8,16    3,X'78',0    SYNTAX ONLY CLUSTER
DATAPL   GEN,8,8,4,12  6,33,8,1     DATA CLUSTER-LINE, PAGE
SPECL    GEN,8,8,8,8   2,X'22',64,2 SPECIFICATION CLUSTER
RDSOCL   GEN,8,8,8,8   10,X'78',0,5 RD SYNTAX ONLY CLUSTER
FILRCL   GEN,8,8,16 2,X'36',0       FILLER CLUSTER
PICLAS   GEN,8,8,8,8   1,3,6,5      PICTURE CLASS
         GEN,8,24      7,0
XCODE    GEN,32   X'80000000'       CODE              -RD
XCOPY    GEN,32   X'40000000'       COPY
XCONT    GEN,32   X'20000000'       CONTROL
XPGLI    GEN,32   X'10000000'       PAGE-LIMIT
XPHEA    GEN,32   X'08000000'       HEADING SUB
XPFIR    GEN,32   X'04000000'       FIRST DETAIL SUB
XPLST    GEN,32   X'02000000'       LAST DETAIL SUB
XPFOO    GEN,32   X'01000000'       FOOTING SUB
XRH      GEN,32   X'00800000'       RH
XRF      GEN,32   X'00400000'       RF
XOH      GEN,32   X'00200000'       OH
XOV      GEN,32   X'00100000'       OV
XPH      GEN,32   X'00080000'       PH
XPF      GEN,32   X'00040000'       PF
XNEXG    GEN,32   X'00020000'       NEXT GROUP        -01
XTYPE    GEN,32   X'00010000'       TYPE
XDE      GEN,32   X'00008000'       DE
XCF      GEN,32   X'00004000'       CF
X01      GEN,32   X'00002000'       01                -GROUP
XLINE    GEN,32   X'00001000'       LINE NUMBER
XSOURS   GEN,32   X'00000800'       SOURCE SELECTED
XELEM    GEN,32   X'00000400'       ELEMETARY         -ELEME
XCOLU    GEN,32   X'00000200'       COLUMN
XGROU    GEN,32   X'00000100'       GROUP INDICATE
XEPIC    GEN,32   X'00000080'       PICTURE
XBLAN    GEN,32   X'00000040'       BLANK ZERO
XJUST    GEN,32   X'00000020'       JUSTIFIED
XREST    GEN,32   X'00000010'       RESET
XSOUR    GEN,32   X'00000008'       SOURCE
XSUM     GEN,32   X'00000004'       SUM
XVALU    GEN,32   X'00000002'       VALUE
XLINEE   GEN,32   X'00000001'       LINE-EL
XRST01   GEN,32   X'FFFC0000'       RESET 01 PART
XGRRST   GEN,32   X'FFFFD7FF'       RESET GROUP PART EXCEPT LINE
XGNPRMT  GEN,32   X'000003FE'       NOT PERMITTED CLAUSES IN GROUP
XSSVNP   GEN,32   X'0000000E'       NOT PERMITTED-SOURCE, SUM,VALUE
PICEL    GEN,32   X'00000376'       CLAUSE NEED A PICTURE
LINECR   DATA,4   C'LINE'           FOR HASH
         DATA,4   C'-COU'
         DATA,4   C'NTER'
PAGECR   DATA,4   C'PAGE'
         DATA,4   C'-COU'
         DATA,4   C'NTER'
PICROT   B        PICAN             BRANCH FOR PICTURE CLUSTER
         B        PICAE
         B        PICND
         B        PICNE
         B        PICND
CNTBCHD  RES      0
         B        SOURSD            SOURCE SELECTED
         B        TYPEDO            TYPE CONTROL
         B        EDF21             DATA ENTRY
CNTBCHS  RES      0
         B        SOURSSD
         B        CNDRCS
         B        SAD
CNTBCDQ  RES      0
         B        SOURSQ
         B        CNDRQD
         B        SAD
CNTBCSQ  RES      0
         B        SOURSSQ
         B        CNDRQS
         B        SAD
SUBSLCT  RES      0
         B        SOURSS
         B        SNDSUB
         B        SAD
SUBBR    DATA     X'578D000'        CONTROL BYTE
         DATA     X'577D000'
PBCONT   DATA     X'0788000'
         DATA     X'0778000'
HDBRNC   DATA     X'0308060C'       H OF CLUSTER
         DATA     X'0A0A0E00'
HSBRNC   DATA     X'0409070D'
         DATA     X'0B0B0F00'
STPHF7   MTW,1    PHASEF            SET PHASE FLAG
         B        STPHF8+4
STPHF8   LI,1     21                MISSING DIVISION DIAG
         BAL,11   DIAG
         LI,B3    -1
         STW,B3   PHASEF
         LI,B3    0                 RESET PDB
         STW,B3   PDBR
         LI,B3    X'2000'
         STS,B3   PDBP
         B        SAD
EROR     BAL,B11  DIAG              GO TO DIAGNOSTICS
         B        SAD
EROR1    BAL,B11  DIAG
         B        *B2
OUTEDF0  LI,B6    X'235'            END OF RRD CLUSTER
         STH,B6   CLSTOR
         B        OUTEDF1
OUTEDF   LI,B1    SADNO
OUTEDF1  STW,4    STB4
         LI,4     BA(CLSTOR)
         BAL,B11  WREDF
         LW,4     STB4
         B        *B1
OUTRRF   LI,B1    SADNO
OUTRRF1  STW,4    STB4
         LI,4     BA(CLSTOR)
         BAL,B11  WRRRF
         B        OUTEDF1+3
OUTFIL   LW,B6    LEVELN            OUTPUT FILLER CLUSTER
         LI,B5    2
         STB,B6   FILRCL,B5
         STW,4    STB4
         LI,4     BA(FILRCL)
         B        OUTEDF1+2
OUTVAL   STW,4    STB4              OUTPUT VALUE CLUSTER
         LI,4     BA(VACLSV)
         B        OUTEDF1+2
OUTPIC   STW,4    STB4              OUTPUT PICTURE CLUSTER
         LI,4     BA(DDBAT)
         B        OUTEDF1+2
OUTELC   LI,B5    X'0232'           OUTPUT END OF LINE CLUSTER
         STH,B5   CLSTOR
         BAL,B1   OUTEDF1
         B        *B2
ALFLG    LI,B2    0                 SET ALLFLG TO ZERO
         STW,B2   ALLFLG
         B        SADNO
STALL    LI,B2    1                 ALL FLAG
         B        ALFLG+1
SLITF    AI,3     -1                LITERAL
         STW,3    DFLAG
         B        SADNO
CKNPMT   AND,B3   HISTORY           CHECK CLAUSE NOT PERMITTED
         BCR,3    *B2
         LI,B1    43
         B        EROR1
CKREQ    AND,B3   HISTORY           CHECK REQUIRED CLAUSE
         BCS,3    *B2
         LI,B1    17
         B        EROR1
CKDUP    LW,B5    B3                CHECK DUPLICATION
         AND,B3   HISTORY
         BCR,3    %+3
         LI,B1    18
         B        EROR1
HSTRYS   EOR,B5   HISTORY           SET HISTORY REGISTER
         STW,B5   HISTORY
         B        *B2
TYPEDIA  LI,B1    42                DIAGNOSTICS FOR 01 LEVEL
         B        EROR
SNDSUB   RES      0
         LI,B2    0
         B        SUBCLST
CNDRCD   LI,B6    0                 REF IN RRF-CONTROL
SNDSUB1  LI,B2    0
         B        IDENTCL
CNDRCS   LI,B6    X'200'
         B        SNDSUB1
CNDRQD   LI,B6    X'100'
         B        SNDSUB1
CNDRQS   LI,B6    X'300'
         B        SNDSUB1
SOURSSD  LI,B6    X'200'
SOURSD   LI,B2    1
         B        IDENTCL
SOURSQ   LI,B6    X'100'
         B        SOURSD
SOURSSQ  LI,B6    X'300'
         B        SOURSD
DATAN1   LW,B3    DCONTRL           DATA-NAME PORTION
         MTW,0    SVRPF             SEE IF REPLACING BY                 COBOL13
         BEZ      %+2               NO                                  COBOL13
         B        SAD               YES DO NOT WRITE CLUSTER            COBOL13
         LW,B2    DASBS
         BNEZ     DATAN2
         AI,B3    -5
         BLZ      CNDRCD
         B        CNTBCHD,B3
DATAN2   AI,B3    -5
         BLZ      CNDRCS
         B        CNTBCHS,B3
QUALN1   LW,B3    DCONTRL           QUALFIER PORTION
         MTW,0    SVRPF             SEE IF REPLACING BY                 COBOL13
         BEZ      %+2               NO                                  COBOL13
         B        SAD               YES DO NOT WRITE CLUSTER            COBOL13
         LW,B2    DASBS
         BNEZ     QUALN2
         AI,B3    -5
         BLZ      CNDRQD
         B        CNTBCDQ,B3
QUALN2   AI,B3    -5
         BLZ      CNDRQS
         B        CNTBCSQ,B3
GETSN1      LI,B6 X'100'            SUBSCRIPT INTEGER
         B        GETSN3
GETSN2   RES      0
         LI,B6    X'200'            INDEX - SUBSCRIPT
         MTW,0    IDXIDF
         BEZ      %+2
         AI,B6    X'100'
GETSN3   LW,B3    DCONTRL
         AI,B3    -5
         BLZ      SNDSUB
         B        SUBSLCT,B3
IDENTCL  AI,B3    5                 FORM REFERENCE CLUSTER
         LB,B7    HDBRNC,B3
         OR,B6    B7
         OR,B6    PBCONT,B2
         MTW,0    HASHNUM
         BGEZ     %+2
         AI,B6    X'1000'
         STW,B6   CLSTOR
         BAL,11   MVIJK
         BAL,B1   MVNFLA
         B        OUTRRF
SOURSS   LI,B6    X'100'
SUBCLST  AI,B3    5                 SUBSCRIPT CLUSTER
         LB,B7    HSBRNC,B3
         OR,B6    B7
         OR,B6    SUBBR,B2
         STW,B6   CLSTOR
         LW,B6    INTGR
         STW,B6   CLSTOR+1
         LI,B6    5
         STB,B6   CLSTOR+2
         LI,B1    0
         STW,B1   IDXIDF
         B        OUTRRF
SETDS    MTW,1    DASBS             SET SUBSCRIPT FLAG
         B        SAD
RSTDS    MTW,-1   DASBS             RESET SUBSCRIPT FLAG
         B        SAD
SSIGN    MTW,1    IDXIDF            INDEXING FLAG
         B        SAD
MVIJK    LI,B8    6                 MOVE IJK OF CLUSTER
         LW,B6    HASHNUM
         STH,B6   CLSTOR+1
         BGEZ     *11
         LI,B7    BA(CLSTOR)
         LB,B6    BYTESNWD
         LW,B5    B8
         STB,B6   CLSTOR,B5
         AI,B8    1
         AW,B7    B8
         STB,B6   B7
         AW,B8    B6
         LI,B6    BA(STRING)
         MBS,B6   0
         B        *11
MVCD     LI,B7    BA(CLSTOR)
         AW,B7    B8
         LI,B6    4
         AI,B8    4
         STB,B6   B7
         LI,B6    BA(CARDNO)
         MBS,B6   0
         B        *11
DATAH    LW,B6    L(X'338000')
         MTW,0    HASHNUM
         BGEZ     %+2
         AI,B6    X'1000'
         STW,B6   CLSTOR
         B        *11
MVNFLA   AI,B8    2
         SLS,B8   -1
         STB,B8   CLSTOR
         B        *B1
RDBHD    LI,B6    X'20C'            REPORT SECTION HEADER
         STH,B6   CLSTOR
         B        OUTEDF
COPYFL   LW,B5    XCOPY             SET COPY FLAG
         BAL,B2   HSTRYS
         B        SAD
EXNAMF   MTB,1    EXNAME            SET NO DNT FLAG
         B        SAD
STGROU   LW,B3    XCONT             CHECK GROUP INDICATE FLAG
         AND,B3   HISTORY
         BCS,2    %+6
         LW,B3    XPGLI
         AND,B3   HISTORY
         BCS,2    %+3
         LI,B1    17
         BAL,B11  DIAG
         LW,B3    XGROU
         B        STBLAN2                                       QA-40
DBDE7    LI,B6    0                 RESET HISTORY REGISTER
         STW,B6   HISTORY
         STW,B6   RD01F             RESET REPORT RECORD FLAG            COBOL13
         STW,B6   FIRLF
         LI,3     6
         STW,6    DDBAT-1,3         RESET FOR G OF SYNTAX-ONLY CLUSTER
         BDR,3    %-1
         LW,B3    RDBAD             OUTPUT DB CLUSTER
DBDE71   LB,B6    BYTESNWD
         LI,B7    BA(STRING)
         STB,B6   B7
         LW,B6    RDBAD,B3
         LW,8     L(X'00FF0000')
         AND,8    3,6
         SLS,8    -16
         CB,8     BYTESNWD
         BCS,3    %+5
         SLS,B6   2
         AI,B6    14
         CBS,B6   0
         BCR,3    DBDE72
         BDR,B3   DBDE71
         LI,B1    40
         BAL,B2   EROR1             FORM NEW RDB
         LI,B6    X'05'
         SLS,B6   24
         STW,B6   RDBST
         LI,B6    0
         STW,B6   RDBST+1
         STW,B6   RDBST+2
         MTW,1    DBCNTR
         LW,B6    DBCNTR
         LW,B7    BYTESNWD
         SLD,B6   8
         STH,B6   RDBST+3
         LI,B7    BA(RDBST+3)+2
         STB,B6   B7
         LI,B6    BA(STRING)
         MBS,B6   0
         LI,B3    BA(RDBST)
         LW,B7    DBCNTR
         SLS,B7   24
         B        %+4
DBDE72   LW,B3    RDBAD,B3
         LW,B7    3,B3
         SLS,B3   2
         LI,B6    X'1084'
         MTW,0    HASHNUM
         BGEZ     %+2
         AI,B6    X'10'
         SLD,B6   8
         STW,B6   CLSTOR
         BAL,11   MVIJK
         BAL,11   MVCD
         LI,B7    BA(CLSTOR)
         AW,B7    B8
         LI,B6    14
         LW,B2    B3
         AI,B2    13
         LB,B1    0,B2
         AW,B6    B1
         AI,B6    3                                                     COBOL13
         AND,B6   L(X'FFFFFFFC')                                        COBOL13
         AWM,B6   PDBN
         AW,B8    B6
         STB,B6   B7
         LW,B6    B3
         MBS,B6   0
         BAL,B1   MVNFLA
         MTW,1    PDBL
         STW,4    STB4
         LI,4     BA(CLSTOR)
         BAL,B1   OUTEDF1+2
         LW,B6    L(X'F88001')
         MTW,0    HASHNUM
         BGEZ     %+2
         AI,B6    X'1000'
         STW,B6   CLSTOR
         BAL,11   MVIJK
         BAL,B1   MVNFLA
         BAL,B1   OUTRRF1
DBDE73   LW,B6    DATAPL            DATA ENTRY CLUSTER, LINE
         STW,B6   CLSTOR
         LCI      3
         LM,B5    LINECR
         STM,B5   STRING
         LI,B6    12
         STB,B6   BYTESNWD
         LI,B6    54
         STW,B6   HASHNUM
         BAL,10   HASH
         BAL,B2   DCLSTR
         BAL,B2   OUT2FC
         LW,B6    SPECL
         STW,B6   CLSTOR            SPECIFICATION CLUSTER, LINE
         BAL,B1   OUTEDF1
         LW,B6    DATAPL            DATA ENTRY CLUSTER, PAGE
         STW,B6   CLSTOR
         LCI      3
         LM,B5    PAGECR
         STM,B5   STRING
         LI,B6    12
         STB,B6   BYTESNWD
         LI,B6    26
         STW,B6   HASHNUM
         BAL,10   HASH
         BAL,B2   DCLSTR
         BAL,B2   OUT2FC
         LW,B6    SPECL
         STW,B6   CLSTOR            SPECIFICATION CLUSTER, PAGE
         B        OUTEDF
CODERC   LW,B3    XCODE             CHECK CODE FLAG
         BAL,B2   CKDUP
         LW,B3    XCOPY
         AND,B3   HISTORY
         BCR,3    %+3
         LI,1   43                  CODE FLAG AFTER COPY CLAUSE
         BAL,B2   EROR1
         LW,B7    L(X'788002')
         MTW,0    HASHNUM
         BGEZ     %+2
         AI,B7    X'1000'
         STW,B7   CLSTOR
         BAL,11   MVIJK
         BAL,11   MVCD
         BAL,B1   MVNFLA
         B        OUTRRF
DCLSTR   BAL,11   MVIJK
         BAL,11   MVCD
         BAL,B1   MVNFLA
         BAL,B1   OUTEDF1
         B        *B2
STCONT   LW,B3    XCONT             CHECK CONTROL FLAG
         LI,B6    0
STCONT1  STW,B6   DCONTRL
         B        STBLAN2
STPAGE   LW,B3    XPGLI             CHECK PAGE LIMIT FLAG
         B        STBLAN2
STFINL   MTW,1    FINALF            SET FINAL FLAG
         B        SAD
CDNUM    LI,B6    1                 INITIATE DATA-NAME COUNTER
         STW,B6   DATANC
         B        SAD
ACDNUM   MTW,1    DATANC            UPDATE DATA-NAME COUNTER
         B        SAD
HFLF     STW,B3   DDBAT             PAGE CLAUSE
         LW,B3    XPHEA-1,B3
         B        STBLAN2
SAVNO    LI,B6    0                 CHECK LEVEL NO
         STW,B6   GNAMF
         LW,B6    INTGR
         LW,B5    SYNNO
         BCS,3    SAVNO0
         LW,B3    L(X'037F0000')
         STW,B3   CLSTOR
         LI,B3    3
         STB,B6   CLSTOR,B3
         BAL,B1   OUTRRF1
SAVNO0   LW,B6    INTGR             CHECK LEVEL NUMBER
         BCS,2    SAVNO1
         LI,B1    35
         BAL,B2   EROR1
*        SIDR 4636 REMOVED MTW,1  CKOTLF                                COBOL13
*        THIS WAS REPLACED BY THE NEXT 2 INSTRUCTIONS                   COBOL13
         LI,B6     49              FORCE LEVEL OF 49 TO BE USED         COBOL13
         STW,B6    LEVELN          STORE NEW LEVEL NUMBER               COBOL13
         B        VCOLAF
SAVNO1   LI,B3    7
         STW,B3   DCONTRL
         STW,B6   LEVELN
         BDR,B6   SAVNO2            NOT 01 RECORD                       COBOL13
         MTW,1    RD01F             SET BAD REPORT RECORD FLAG          COBOL13
         LW,B5    XRST01
         AND,B5   HISTORY
         STW,B5   HISTORY
         B        VCOLAF                                                COBOL13
SAVNO2   MTW,0    RD01F                                                 COBOL13
         BNEZ     SAVNO3            GOOD REPORT RECORD                  COBOL13
         LI,B1    285               NO 01 REPORT RECORD                 COBOL13
         BAL,B2   EROR1                                                 COBOL13
         MTW,1    RD01F             DEFAULT                             COBOL13
SAVNO3   AI,B6    -48               CHECK LEVEL < 50                    COBOL13
         BCS,2    SAVNO0+2
VCOLAF   LI,B6    0
         STW,B6   COLAFLG
         STW,B6   SSLECT
         B        SAD
SVPGLN   LW,B6    INTGR             SAVE PAGE-L LINE NUMBER
         STW,B6   DDBAT+5
         LI,B6    0
         LI,B3    4
         STW,B6   DDBAT,B3
         BDR,B3   %-1
         B        SAD
SUBPGN   LW,B3    DDBAT             SAVE PAGE-SUB NUMBER
         LW,B6    INTGR
         STW,B6   DDBAT,B3
         B        SAD
STLINE   MTW,1    LINEF             SET LINE CLAUSE FLAG
         LI,B6    X'10'
         STW,B6   HSTOR
         LW,B6    FIRLF
         BCS,3    %+3
         MTW,1    FIRLF             NO END OF LINE CLUSTER OUTPUT
         B        %+2
         BAL,B2   OUTELC
         LI,B6    X'0231'
         STH,B6   CLSTOR
         B        OUTEDF
STBLAN   LW,B3    XBLAN             CHECK BLANK FLAG
         STW,B3   BWZ                                                BWZ
         LW,B2    L(X'02220202')
STBLAN1  STW,B2   CLSTOR
         BAL,B1   OUTEDF1
STBLAN2  BAL,B2   CKDUP
         B        SAD
STJUST   LW,B3    XJUST             CHECK JUSTIFIED FLAG
         LW,B2    L(X'02220102')
         B        STBLAN1
STREST   LW,B3    XREST             CHECK RESET FLAG
         LI,B6    1
         B        STCONT1
STSOUR   LW,B3    XSSVNP            CHECK SOURCE FLAG
         LW,B5    XSOUR
         LI,B6    4
         B        STSUM1-1
STSUM    LW,B3    XSSVNP            CHECK SUM FLAG
         LW,B5    XSUM
         LI,B6    2
         STW,B6   DCONTRL
STSUM1   BAL,B2   CKDUP+1
         B        SADNO
STSUMU   MTW,1    DCONTRL           SUM UPON
         B        SAD
STVALU   LW,B3    XSSVNP            CHECK VALUE FLAG
         LW,B5    XVALU
         MTW,1    PDBR
         B        STSUM1
SOURRF   MTW,1    DCONTRL           RESET DCONTRL AND FLAG-SOURCE SEL
         LW,B6    XSOUR
         EOR,B6   HISTORY
         STW,B6   HISTORY
         MTW,1    SSLECT
         B        SAD
CSTYPE   LW,B6    LEVELN            CHECK TYPE FLAG
         BDR,B6   TYPEDIA
         LW,B3    XTYPE
         B        STBLAN2
STNEXT   LW,B6    LEVELN            CHECK NEXT GROUP FLAG
         BDR,B6   TYPEDIA
         LI,B3    X'13'
         STW,B3   HSTOR
         LW,B3    XNEXG
         B        STBLAN2
PRO      AI,B3    -1                TYPE CLAUSE
         STW,B3   ROCPF
         B        SAD
BRSTF1   LW,B3    ROCPF             BRANCH TO CHECK FLAG
         BCR,3    RHRF              RH
         AI,B3    1                 PH, OH
         B        POHFV
BRSTF2   LW,B3    ROCPF
         BNEZ     BRSTF3
         AI,B3    1                 RF
         B        RHRF
BRSTF3   AI,B3    2                 PF, OV
         B        POHFV
RHRF     LW,B6    B3                RH, RF
         LW,B3    XRH,B3
         BAL,B2   CKDUP             CHECK DUPLICATION
         LH,B2    NRHF,B6
         B        TYPERO
POHFV    LW,B6    B3                PH, PF
         CI,B3    2
         BL       POHFV1
         LW,B3    XPGLI
         B        POHFV2
POHFV1   LW,B3    XPLST             OH, OV
POHFV2   BAL,B2   CKREQ
         LW,B3    XOH,B6
         BAL,B2   CKDUP             CHECK DUPLICATION
         LB,B2    NPOF,B6
         B        TYPERO
CSCF     LW,B3    XCF               CF FLAG
         BAL,B2   CKDUP             CHECK DUPLICATION
CSCH     LW,B3    XCONT             CHECK FOR CH
         BAL,B2   CKREQ
         LI,B6    6
         STW,B6   DCONTRL
         B        SAD
XRSOU    LW,B5    XSOUR             CLEAR SOURCE BIT OF HISTORY
         B        XRSUM+1
XRSUM    LW,B5    XSUM              CLEAR SUM BIT OF HISTORY
         EOR,B5   HISTORY
         STW,B5   HISTORY
         LI,B1    36                DIAGNOSTIC - INVALID DATA NAME
         B        EROR
ONETST   LW,B6    LEVELN            TEST FOR 01 LEVEL
         AI,B6    -1
         BCR,3    SADYES
         B        SADNO
SET23F   LW,B6    DCONTRL           OUTPUT FILLER CLUSTER
         AI,B6    -7
         BCS,3    SAD
         BAL,B1   OUTFIL
         B        SAD
TYPEDO   LI,B6    X'16'             SYNTAX ONLY CLUSTER FOR TYPE CF, CH
         BAL,B1   SYOCL
         LW,B6    XCF
         AND,B6   HISTORY
         BCR,3    %+3
         LI,B2    7
         B        %+2
         LI,B2    3
         STB,B2   CLSTOR+1
         BAL,B1   OUTRRF1
         B        CNDRCD
STPICF   LI,B2    1
         STB,B2   PICTYOUR
         BAL,B11  SCAN
         LW,B3    XEPIC
         B        STBLAN2
LASTCK   LW,B3    PIC
         BCR,3    LASTCKI
         LI,B3    0                                                  BWZ
         STW,B3   PIC                                                BWZ
         BAL,B1   PICTURE
         LW,B3    PICINFO
         LI,B2    BA(PICLAS+1)
         LI,B1    5
         LB,B6    0,B2
         SW,B6    B3
         BCR,3    %+4
         AI,B2    -1
         BDR,B1   %-4
         B        LASTCKI
         LW,B6    XBLAN             CHECK NUMERIC FOR BLANK
         AND,B6   HISTORY
         BCR,3    %+4
         BDR,B1   %+2
         B        LASTCKI
         AI,B1    1
         LW,B6    PICINFO+1
         SLD,B6   -16
         LI,B6    X'2A'
         SLD,B6   16
         STW,B6   DDBAT
         EXU      PICROT-1,B1
PICAN    LI,B6    3                 FORM PICTURE CLUSTER-AN
         STB,B6   DDBAT
         STB,B3   DDBAT+1
PICOC    BAL,B1   OUTPIC
         B        LASTCKI
PICND    LI,B6    4                 FORM PICTURE CLUSTER-ND,NDU
         STB,B6   DDBAT
         LW,B6    PICINFO+2
         SLD,B6   -16
         LW,B6    B3
         SLD,B6   24
         STW,B6   DDBAT+1
         B        PICOC
PICAE    LI,B2    7                 FORM PICTURE CLUSTER-AE
         LW,B6    PICINFO+2
         SLD,B6   -16
         LI,B6    3
         SLD,B6   24
         STW,B6   DDBAT+1
         LI,B7    BA(DDBAT)
         AW,B7    B2
         LB,B6    PICINFO+3
         AI,B6    1
         AW,B2    B6
         STB,B6   B7
         LI,B6    BA(PICINFO+3)
         MBS,B6   0                 MOVE MASK DISCRIPTOR
PICAE1   LI,B7    BA(DDBAT)
         AW,B7    B2
         LW,B6    PICINFO+1
         AW,B2    B6
         STB,B6   B7
         LI,B6    BA(PICINFO+11)
         MBS,B6   0                 MOVE EDITING MASK
         AI,B2    2
         SLS,B2   -1
         STB,B2   DDBAT
         B        PICOC
PICNE    LI,B2    13                FORM PICTURE CLUSTER-NE
         LW,B6    PICINFO+4
         SLD,B6   -4
         LW,B6    PICINFO+3
         SLD,B6   -2
         SLS,B6   -14
         SLD,B6   -2
         LW,B6    PICINFO+2
         SLD,B6   -16
         LI,B6    5
         SLD,B6   24
         STW,B6   DDBAT+1
         LW,B6    PICINFO+10
         SLD,B6   -8
         LW,B6    PICINFO+8
         SLD,B6   -8
         LW,B6    PICINFO+7
         SLD,B6   -8
         LW,B6    PICINFO+6
         SLD,B6   -6
         LW,B6    PICINFO+9
         SLD,B6   -2
         STW,B7   DDBAT+2
         LW,B6    PICINFO+5
         STB,B6   DDBAT+3
         B        PICAE1
EDF21    BAL,11   DATAH             OUTPUT DATA ENTRY CLUSTER
         LW,B7    LEVELN
         LI,B2    3
         STB,B7   CLSTOR,B2
         BAL,B2   DCLSTR
         B        SAD
SYOCL    LW,B5    SYOLYC            FORM SYNTAX ONLY CLUSTER
         STW,B5   CLSTOR
         LI,B5    3
         STB,B6   CLSTOR,B5
         B        *B1
TYPERO   LI,B6    X'16'             FORM SYNTAX ONLY CLUSTER-TYPE
         BAL,B1   SYOCL
         STB,B2   CLSTOR+1
         B        OUTRRF
LCKPG1   LW,B3    XPGLI             CHECK PAGE-LIMIT FOR LINE
         BAL,B2   CKREQ
         B        SAD
LCKPG2   LW,B3    HSTOR
         CI,B3    X'11'
         BCR,3    SAD
         B        LCKPG1
LSOCL    LI,B6    X'12'             OUTPUT SYNTAX ONLY CLUSTER-LINE
         B        GSOCL2+1
CNTFR    LI,B6    X'19'             OUTPUT SYNTAX ONLY CLUSTER-TYPE F
         BAL,B1   SYOCL
         LW,B6    XCF
         LI,B2    X'03'
         AND,B6   HISTORY
         BCR,3    TYPERO+2
         AI,B2    X'04'
         B        TYPERO+2
OVALEI   LW,B6    PDBR              FORM VALUE CLUSTER
         SLD,B6   -16
         MTW,1     VALFLG           SET VALUE FLAG                      COBOL13
         LW,B6    VALUCL
         SLD,B6   16
         STW,B6   VACLSV
         LI,B3    1
         STB,B3   VACLSV+1
OIVFL    LW,B3    DFLAG             FORM IVF
         BCS,1    OIVFL1            GO TO FORM NUMERIC
         AI,B3    -5
         BCR,3    OIVFL2            GO TO FORM LITERAL STRING
         LW,B6    DFLAG
         AI,B6    X'30'
         B        OIVFL0
OIVFL1   LI,B6    X'C0'
         B        OIVFL0
OIVFL2   LW,B6    ALLFLG
         AI,B6    X'B0'
OIVFL0   STB,B6   B7
         LW,B6    PDBR
         SLD,B6   8
         STW,B6   CLSTOR
         LI,B6    0
         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,B6   CLSTOR+1
         LI,B2    3
         B        OIVFL5+2
OIVFL3   LW,B7    POINTLOC
         SLS,B7   24
         SLD,B6   8
         LW,B7    BYTESNLT
         SLD,B6   16
         STW,B6   CLSTOR+1
         LI,B7    BA(CLSTOR)+11
         LB,B6    BYTESNLT
         STB,B6   B7
         LI,B6    BA(INTAGER)
         MBS,B6   0
         LB,B2    BYTESNLT
         AI,B2    7
         B        OIVFL5
OIVFL4   LB,B6    BYTESNWD
         STH,B6   CLSTOR+1
         LI,B7    BA(CLSTOR)+6
         STB,B6   B7
         LI,B6    BA(STRING)
         MBS,B6   0
         LB,B2    BYTESNWD
         AI,B2    6
OIVFL5   AI,B2    2
         SLS,B2   -1
         STB,B2   CLSTOR
         STW,4    STB4
         LI,4     BA(CLSTOR)
OIVFL6   BAL,11   WRIVF             OUTPUT IVF
         LW,4     STB4
         B        SAD
SOCRRF   LI,B6    0                 SET REPORT GROUP REF COUNTER
         STW,B6   RGRN1
         STW,B6   RGRN2
         LW,B6    RDSOCL            RD SYNTAX ONLY CLUSTER
         STW,B6   CLSTOR
         LW,B6    XPGLI
         AND,B6   HISTORY
         BCS,3    %+3
         LI,B6    0
         B        %+2
         LW,B6    DDBAT+5
         LW,B7    DDBAT+1
         STH,B6   B7
         STW,B7   CLSTOR+1
         LW,B6    DDBAT+2
         LW,B7    DDBAT+3
         STH,B6   B7
         STW,B7   CLSTOR+2
         LW,B6    DDBAT+4
         LW,B7    HISTORY
         SLD,B6   16
         STW,B6   CLSTOR+3
         LW,B6    FINALF
         SLD,B6   -8
         LW,B6    DATANC
         SLD,B6   -8
         STW,B7   CLSTOR+4
         BAL,B1   OUTRRF1
         LI,B6    0
         STW,B6   FINALF
         B        SAD
SGPLF    MTW,1    HSTOR             SET NEXT GROUP PLUS FLAG
         B        SAD
GCKPG    LW,B3    HSTOR             CHECK PAGE-LIMIT FOR NEXT
         CI,B3    X'14'
         BCR,3    SAD
         LW,B3    XPGLI
         BAL,B2   CKREQ
         B        SAD
GSOCL1   LW,B6    HSTOR             SYNTAX ONLY CLUSTER
         BAL,B1   SYOCL
         LW,B2    INTGR
         B        TYPERO+2
GSOCL2   LI,B6    X'15'             NEXT PAGE
         BAL,B1   SYOCL
         LI,B2    0
         B        TYPERO+2
TYPEC    LW,B3    XDE               UPDATE RGRN1
         BAL,B2   CKDUP
         MTW,1    RGRN1
         LW,B3    GNAMF             GROUP NAME FOR DE
         BCS,3    SADNO
         LI,1     22
         B        EROR
COLEDF   LW,B3    XCOLU             CHECK COLUMN FLAG
         BAL,B2   CKDUP
         LW,B6    INTGR             OUTPUT REPORT SPECIFICATION CLUSTER
         SLD,B6   -16
         B        REPTC1
REPTC    LW,B3    XDE               TYPE-REPORT SPECIFICATION CLUSTER
         AND,B3   HISTORY
         BCR,3    %+3
         LW,B6    RGRN1
         B        %+3
         MTW,-1   RGRN2
         LW,B6    RGRN2
         SLD,B6   -8
         LI,B6    1
         SLD,B6   -8
REPTC1   LW,B6    REPTCL
         SLD,B6   16
         STW,B6   CLSTOR
         B        OUTEDF
RSTRRF   LI,B6    X'1A'             OUTPUT RESET FINAL CLUSTER
         BAL,B1   SYOCL
         STH,B5   CLSTOR+1
         B        OUTRRF
LASTCKI  LW,B3    XGROU             CHECK GROUP INDICATE
         AND,B3   HISTORY
         BCR,3    LASTCK0
         BAL,B1   OUTFIL
         BAL,B2   OUT2FC
         BAL,B2   OUTPIS1
LASTCK0  LW,B3    XVALU
         AND,B3   HISTORY
         BCR,3    LASTCK1
         MTW,0     VALFLG           TEST VALUE FLAG                     COBOL13
         BEZ       LASTCK1          DO NOT WRITE VALUE CLUSTER          COBOL13
         MTW,-1    VALFLG           TURN FLAG OFF                       COBOL13
         BAL,B1   OUTVAL
LASTCK1  LW,B3    XSUM              CHECK SUM
         AND,B3   HISTORY
         BCR,3    SADNO
         LI,B3    X'0234'
         STH,B3   CLSTOR
         LW,B3    LEVELN
         LI,B2    2
         STB,B3   CLSTOR,B2
         BAL,B1   OUTEDF1
         BAL,B2   OUT2FC
         BAL,B2   OUTPIS
         LW,B3    L(X'02220800')    SPECIFICATION CLUSTER
         STW,B3   CLSTOR
         BAL,B1   OUTEDF1
         B        SADNO
OUT2FC   LI,B3    X'022F'           FOR LINE, PAGE,SUM & GROUP INDICATE
         STH,B3   CLSTOR
         BAL,B1   OUTEDF1
         B        *B2
OUTPIS   LI,B3    6                 OUTPUT 2ND PICTURE CLUSTER
         STB,B3   DDBAT+1
         LI,B3    4
         STB,B3   DDBAT
         LB,B5    DDBAT+2
         BEZ      OUTPIS1           USE SIZE ALREADY IN CLUSTER         COBOL13
         LI,B3    X'3F'
         AND,B3   B5
         LI,B5    1
         STH,B3   DDBAT,B5
OUTPIS1  STW,4    STB4              OUTPUT
         LI,4     BA(DDBAT)
         BAL,B1   OUTEDF1+2
         B        *B2
EXSTNF   LW,B3    GNAMF             GET OR RESET EXNAME
         STB,B3   EXNAME
         B        SADNO
CSETNF   LW,B3    GNAMF
         BNEZ     SADNO             CLUSTER ALREADY OUT
         MTW,1    GNAMF
         B        DATAN1            GO OUTPUT CLUSTER
SETNF    MTW,1    GNAMF             SET GROUP NAME FLAG
         B        SADNO
CKOUT1   LW,B6    INTGR             CHECK GROUP
         STW,B6   SYNNO
         CW,B6    LEVELN
         BCR,2    CKOUT3
         LW,B6    LEVELN
         BDR,B6   %+6
         LW,B5    X01
         BAL,B2   HSTRYS            SET 01 GROUP
         LW,B3    XTYPE
         BAL,B2   CKREQ
         B        %+4
         LW,B5    XGRRST            RESET GROUP PART OF HISTORY
         AND,B5   HISTORY
         STW,B5   HISTORY
         LW,B3    LINEF
         BCR,3    %+5
         LW,B5    XLINE             SET LINE FLAG FOR 01
         OR,B5    HISTORY
         STW,B5   HISTORY
         MTW,-1   LINEF
         LW,B3    SSLECT
         BCR,3    %+3
         LW,B3    XSOURS
         BAL,B2   CKDUP
         LW,B3    XGNPRMT           CHECK NOT PERMITTED IN GROUP
         BAL,B2   CKNPMT
         LI,B5    0
         STW,B5   FLGSTF
         BAL,B1   OUTEDF0
         B        SYNCL
CKOUT2   LW,B5    CKOTLF
         BCR,3    %+3
         MTW,-1   CKOTLF            NO DIAGNOSTICS
         B        SADNO
         STW,B5   SYNNO
         BAL,B1   OUTEDF0
         BAL,B2   OUTELC
         B        CKOUT4
CKOUT3   BAL,B1   OUTEDF0
CKOUT4   LW,B5    XELEM             SET ELEMENTARY FLAG
         BAL,B2   HSTRYS
         LW,B3    LINEF
         BCR,3    %+5
         LW,B5    XLINEE
         BAL,B2   HSTRYS            SET LINE FLAG
         MTW,1    FLGSTF
         MTW,-1   LINEF
         LW,B3    PICEL
         AND,B3   HISTORY
         BCR,3    %+3
         LW,B3    XEPIC
         BAL,B2   CKREQ             CHECK REQUIRED-PICTURE
         LW,B3    SSLECT
         BCR,3    %+2
         BAL,B2   CKNPMT+2          CHECK NOT PERMITTED-SOURCE SELECTED
         LW,B3    XGROU
         AND,B3   HISTORY
         BCR,3    CKOUTC
         LW,B3    XDE
         BAL,B2   CKREQ
         LW,B3    XCOLU
         BAL,B2   CKREQ
CKOUTC   LW,B3    XCOLU
         AND,B3   HISTORY
         BCR,3    %+7
         LW,B3    XLINE             CHECK REQUIRED-COLUMN
         AND,B3   HISTORY
         BCS,3    %+4
         LW,B3    FLGSTF
         BCS,3    %+2
         BAL,B2   CKREQ+2
         LW,B3    XREST
         AND,B3   HISTORY
         BCR,3    %+7
         LW,B3    XCONT
         BAL,B2   CKREQ
         LW,B3    XSUM
         BAL,B2   CKREQ
         LW,B3    XCF
         BAL,B2   CKREQ
         LW,B3    XSUM
         AND,B3   HISTORY
         BCR,3    SYNCL
         LW,B3    XCF
         BAL,B2   CKREQ
SYNCL    LW,B6    SSLECT
         BCR,3    SYNCL1
         LI,B6    X'18'
         BAL,B1   SYOCL
         LW,B6    HISTORY
         STW,B6   CLSTOR+1
         BAL,B1   OUTRRF1
SYNCL1   LW,B6    SYNCCL            SYNCHRONIZATION CLUSTER
         STW,B6   CLSTOR
         LW,B6    HISTORY
         STW,B6   CLSTOR+1
         SLS,B6   -11
         SLS,B6   11
         STW,B6   HISTORY
         LW,B6    SYNNO
         STB,B6   CLSTOR+2
         BAL,B1   OUTRRF
COB13    LI,B2    WA(TBLSN3)        PHASE 1.3 INITIALIZATION
         STW,B2   SYNTABLE
         LI,B2    TBLJMP
         STW,B2   JUMPTBL
         LI,4     0
         B        SADGO
TBLJMP   EQU      %
         B          HFLF                                                00000000
         B          POHFV                                               00000001
         B          PRO                                                 00000002
         B          RHRF                                                00000003
         B          SLITF                                               00000004
         B          A                                                   00000005
         B          ACCT                                                00000006
         B          ACDNUM                                              00000007
         B          ALFLG                                               00000008
         B          BRSTF1                                              00000009
         B          BRSTF2                                              00000010
         B          CCT                                                 00000011
         B          CDNUM                                               00000012
         B          CKOUT1                                              00000013
         B          CKOUT2                                              00000014
         B          CNTFR                                               00000015
         B          CODERC                                              00000016
         B          COLEDF                                              00000017
         B          COMMA                                               00000018
         B          COPYFL                                              00000019
         B          CSCF                                                00000020
         B          CSCH                                                00000021
         B          CSETNF                                              00000022
         B          CSTYPE                                              00000023
         B          DATAN1                                              00000024
         B          DBDE7                                               00000025
         B          DCCT                                                00000026
         B          ENDSOUR                                             00000027
         B          EXNAMF                                              00000028
         B          EXSTNF                                              00000029
         B          FPERD                                               00000030
         B          GCKPG                                               00000031
         B          GETSN1                                              00000032
         B          GETSN2                                              00000033
         B          GSOCL1                                              00000034
         B          GSOCL2                                              00000035
         B          INTEGER                                             00000036
         B          LASTCK                                              00000037
         B          LCKPG1                                              00000038
         B          LCKPG2                                              00000039
         B          LIBCPY                                              00000040
         B          LSOCL                                               00000041
         B          NAME                                                00000042
         B          NONNLIT                                             00000043
         B          NUMBER                                              00000044
         B          ONETST                                              00000045
         B          OVALEI                                              00000046
         B          QUALN1                                              00000047
         B          RDBHD                                               00000048
         B          REPLC                                               00000049
         B          REPTC                                               00000050
         B          RNPTR                                               00000051
         B          RSTDS                                               00000052
         B          RSTRRF                                              00000053
         B          SAVNO                                               00000054
         B          SBW                                                 00000055
         B          SEMICOL                                             00000056
         B          SETDS                                               00000057
         B          SETNF                                               00000058
         B          SET23F                                              00000059
         B          SFRPC                                               00000060
         B          SGPLF                                               00000061
         B          SLIBN                                               00000062
         B          SNC                                                 00000063
         B          SNW                                                 00000064
         B          SOCRRF                                              00000065
         B          SOURRF                                              00000066
         B          SSIGN                                               00000067
         B          STALL                                               00000068
         B          STBLAN                                              00000069
         B          STCONT                                              00000070
         B          STFINL                                              00000071
         B          STGROU                                              00000072
         B          STJUST                                              00000073
         B          STLINE                                              00000074
         B          STNEXT                                              00000075
         B          STPAGE                                              00000076
         B          STPHF7                                              00000077
         B          STPHF8                                              00000078
         B          STPICF                                              00000079
         B          STREST                                              00000080
         B          STSOUR                                              00000081
         B          STSUM                                               00000082
         B          STSUMU                                              00000083
         B          STVALU                                              00000084
         B          SUBPGN                                              00000085
         B          SVPGLN                                              00000086
         B          TYPEC                                               00000087
         B          VCOLAF                                              00000088
         B          WORDR                                               00000089
         B          XRSOU                                               00000090
         B          XRSUM                                               00000091
         END
