         TITLE 'SUPERVISOR'                                             10520001
SYSS00   START 0                                                        10520002
         USING *,0,4                                                    10520003
         ORG   SYSS00+5                                                 10520004
         DC    C' '                                                     10520005
         ORG   SYSS00+88                                                10520006
         DC    X'00040000'              NEW  EXT SIGNAL PSW             10520007
         DC    A(SYSEXT)                                                10520008
         DC    X'00040000'              NEW  SVC INTRT  PSW             10520009
         DC    A(SYSSVC)                                                10520010
         DC    X'00040000'              NEW  PROG CHECK PSW             10520011
         DC    A(SYSSPC)                                                10520012
         DC    X'00060000'              NEW  MACH CHECK PSW             10520013
SYSSMD         DC   X'F0FFFFFF'                                         10520014
         DC    X'00040000'              NEW  IO INTERPT PSW             10520015
         DC    A(SYSXIN)                                                10520016
         DC    YL2(SYSSCR)                                              10520017
         DC    YL2(SYSUTB)                                              10520018
       ORG   SYSS00+144                 DIAGNOSTICS USE 8 BYTES  START  10520019
SYSSLB     DC    X'FF0500000F'                                          10520020
         DC    AL3(SYSLDR)             USE ABSOLUTE LOADER              10520021
SYSS83   DS    D                       TO SAVE PSW BEFORE TIMER RTN     10520022
SYSS86   DS    D                                                        10520023
SYSS81   LM    10,11,SYSS86                                             10520024
         LPSW  SYSS83                  RETURN FROM TIMER RTN            10520025
SYSS84   DS    D                       TO SAVE PSW BEFORE OP.COM RTN    10520026
SYSS87   DS    D                                                        10520027
SYSS03   DC    X'09000000'              CCW WRITE MSG                   10520028
         DC    F'5'                                                     10520029
SYSS04   DC    X'0A000005'              CCW READ  REPLY                 10520030
         DC    F'1'                                                     10520031
SYSZVE   DS    F                       TO SAVE REG 10 FOR MSG HANDLING  10520032
SYSSAC   DS    F                       TO SAVE  REPLY ADDRESS           10520033
SYSSCB   DC    X'1000'                 DUMMY CCB FOR SVC 2 FORCE RTRN   10520034
SYSS93   MVC   24(8),32                                                 10520035
         B     SYSS13                                                   10520036
SYSTWA   DC    X'001F'                 TW ADDRESS                       10520037
SYSSVC   L     12,36                    LOAD ADD IN R12                 10520038
       CLI   35,X'01'       IS V SVC 1                                  10520039
         BL    SYSXCP                   GO TO IOCS (CODE 0)             10520040
         BE    SYSS11                   GO TO FETCH ROUTINE (CODE 1)    10520041
       CLI   35,X'03'       IS V SVC 3                                  10520042
         BNL   SYSS80                                                   10520043
SYSS06   MVC   0(5),0(12)               CODE 2    MESSAGE               10520044
         LA    12,6(12)                 CALCULATE NEXT INSTRUCTION ADDR 10520045
         IC    13,36                   STORE ADDRESS IN PSW             10520046
         ST    12,36                                                    10520047
         STC   13,36                                                    10520048
         BCTR  12,0                    CALCULATE EDDRESS FOR REPLY      10520049
         MVI   SYSS03+4,X'20'          SUPPRESS CHAINING IN CCW         10520050
         CLI   4,C'A'                   IF A  REPLY                     10520051
         BNE   *+8                      IS WANTED PUT CHAINING BIT      10520052
         MVI   SYSS03+4,X'60'                                           10520053
         ST    12,SYSSAC               SAVE ADDRESS FOR REPLY           10520054
         MVC   58(2),SYSTWA            LOAD CH,UNIT ADDRESS             10520055
       LA    12,SYSMSG-SYSQMX                                           10520056
       ST    10,SYSZVE                                                  10520057
         BAL   10,SYSQXS               USE ROUTINE TO SET UP CCW AND T5 10520058
         DC    YL2(SYSS03)             CCW ADDRESS                      10520059
       L     10,SYSZVE                                                  10520060
         TM    SYSSCB,X'20'                                             10520061
         BC    8,SYSS93                 NOT DISASTER,CONTINUE           10520062
SYSS09   OI    32,X'01'                 UNMASK EXT IN                   10520063
         OI    33,X'02'                 AND ENTER WAIT STATE            10520064
SYSXST LPSW  32                         RETURN TO MAIN LINE   SVC       10520065
SYSS82   LM    10,11,SYSS87                                             10520066
         NI    SYSSOC+1,X'0F'          ACCEPT NEXT ATTENTION ON 1052    10520067
         LPSW  SYSS84                  RETURN FROM OP.COM. RTN          10520068
SYSS80   CLI   35,X'04'                                                 10520069
         BE    SYSS82                  CODE 3  RETURN FROM OP.COM RTN   10520070
         BL    SYSS81                  CODE 3  RETURN FROM TIMER RTN    10520071
SYSS10   MVI   35,X'10'                 SVC CODE ERROR                  10520072
         MVC   40(8),32                 SIMULATE PROG CHECK             10520073
         B     SYSSPC                   WITH INTRT CODE 00010000        10520074
SYSS11   CLC   0(6,12),SYSSLC           COMPARE NAME WITH EOJ           10520075
SYSSAT   MVC   32(8),SYSSLB             MOVE  PROB PSW                  10520076
         BNE   SYSS09+8                 LOAD PSW                        10520077
         B     SYSS09+4                 LOAD PSW WITH WAIT STATE        10520078
SYSEXT   TM    27,X'80'                IS IT TIMER INTERRUPT            10520079
         BO    SYSSTM                  GO TO HANDLING OF TIMER INTERRUP 10520080
SYSS13   CLI   4,C'A'                   IF REPLY NOT REQUIRED           10520081
         MVI   4,C' '                                                   10520082
         BNE   SYSS15                   IGNORE THIS MSG                 10520083
         L     12,SYSSAC                                                10520084
         MVC   0(1,12),5                MOVE REPLY IN CALLING SEQUENCE  10520085
         CLI   5,C' '                                                   10520086
         BE    SYSS15                   IGNORE CODE IF BLANK            10520087
         NI    5,X'FC'                 IS CODE 0 TO 4 IN BINARY         10520088
         CLI   5,X'F0'                  OR CHARACTER FORM               10520089
         BE    SYSS17                                                   10520090
SYSS14   CLI   5,X'02'                  IF CODE 0 OR 1                  10520091
         BL    SYSS18                   GO TO ABNORMAL END OF JOB       10520092
         CLI   5,X'03'                                                  10520093
         BE    SYSS99                                                   10520094
         BL    SYSS19                   GO TO -SET 7TH BIT ON IN UPSI - 10520095
SYSS15   MVI   5,C' '                   IGNORE OR END OF MSG-REPLY      10520096
         NI    25,X'FD'                 PROCESSING                      10520097
SYSS16   LPSW  24                                                       10520098
SYSS99   NI    SYSUPS,X'FE'                                             10520099
         B     SYSS15                                                   10520100
SYSS17 MVC   5(1),0(12)                                                 10520101
         NI    5,X'0F'                           INTO BINARY FORM       10520102
         B     SYSS14                                                   10520103
SYSS19   OI    SYSUPS,X'01'            SET ON 8TH BIT OF UPSI           10520104
         B     SYSS15                                                   10520105
SYSS20   DC    H'1'                                                     10520106
SYSSTM   MVC   SYSS83(8),24            SAVE OLD PSW                     10520107
         STM   10,11,SYSS86                                             10520108
         LH    12,SYSRTA+2             IS AN USER(S RTN PROVIDED        10520109
         LTR   12,12                                                    10520110
         BZ    SYSS81                  NO - RETURN                      10520111
         STH   12,30                   YES - GO TO THIS ROUTINE         10520112
         LPSW  24                                                       10520113
SYSSOC   BC    0,SYSSCX                ACCEPT OR NOT ATTENTION ON 1052  10520114
         MVC   SYSS84(8),56            SAVE OLD PSW                     10520115
         STM   10,11,SYSS87                                             10520116
         SVC   2                       MACRO TO ASK FOR THE CODE        10520117
         DC    C'0902A '                                                10520118
         LH    12,SYSRTA+4             IS AN USER,S RTN PROVIDED        10520119
         LTR   12,12                                                    10520120
         BZ    SYSS82                  NO - RETURN                      10520121
         STH   12,62                   YES - GO TO THIS ROUTINE         10520122
         OI    SYSSOC+1,X'F0'          1052 ATTENTION NOT ACCEPTED      10520123
SYSSCX   LPSW  56                                                       10520124
         DS    0F                                                       10520125
SYSS21   DC    X'0000FFFF'              MASK FOR LOAD HALFWORD          10520126
SYSSCR   DC    F'0'                    COMMUNICATION REGION- MONTH-DAY  10520127
         DC    H'0'                                           YEAR      10520128
         DC    X'000000'                                      DATE      10520129
         DC    X'00'                                          CONFIG    10520130
SYSEND   DC    YL2(SYSSND)             END OF SUPERVISOR                10520131
SYSUSR   DC    2F'0'                   FOR USER - RESET BY SYSEOJ       10520132
         DC    3C'0'                             NOT RESET              10520133
SYSUPS   DC    X'00'                   UPSI                             10520134
SYSS26   DC    C'NAMEXX'                                                10520135
SYSRTA   DC    2FL4'0'                 PC-TIMER-OP.COM-1015 ROUTINES    10520136
         DC    X'0000'                 SYSEOJ SWITCHES                  10520137
SYSSPC   LH    13,SYSRTA                                                10520138
               CH   13,SYSS20                                           10520139
         BC    12,SYSSPD                                                10520140
               MVC  32(8),40                                            10520141
               STH  13,38                                               10520142
               LPSW 32                                                  10520143
SYSSPD         SVC  2                                                   10520144
         DC    C'0901  '               MESSAGE FOR PROG CHECK           10520145
SYSS18   CLR   13,13                    RESET COND CODE TO ZERO         10520146
         MVI   5,C' '                                                   10520147
         B     SYSS11+6                   AND BRANCH TO LOAD PROB PSW   10520148
SYSSLC   DC    C'SYSEOJ'                                                10520149
*                                                                       10520150
SYSUTB   DC    X'00000005'             SYSRES CONTAINS PUB LIMITS       10520151
       DC    X'00080801'                1402,UNIT 08,SYSRDR             10520152
       DC    X'00100602'                1403,UNIT 10,SYSLST             10520153
       DC    X'000A0403'                1442,UNIT 0A,SYSIPT             10520154
       DC    X'00040A04'                1402,UNIT 04,SYSOPT             10520155
SYSUTY DC    X'001F0200'                1052,UNIT 1F,SYSLOG             10520156
         DC    X'00000000'             SYS000                           10520157
         DC    X'00000000'             SYS001                           10520158
         DC    X'00000000'             SYS002                           10520159
         DC    X'00000000'             SYS003                           10520160
         DC    X'00000000'             SYS004                           10520161
*  *  *  TAPE BIASED SIMPLER SCHEDULER *  *  *                          10520162
SYSENS   EQU   SYSS00+24                HOLD C SENSE INFO               10520163
SYSHLD EQU   8           HOLDING AREA FOR TYPE MSG                      10520164
SYSUSE EQU   19                         BYTE SHOWS ACTIVITY ON CHANNLS  10520165
*            * * * REQUEST I/O ENTRY POINT * * *                        10520166
* * *  SPVR  LOADED REG 12  FOR ME                                      10520167
SYSXCP LH    13,0(12)                   LOAD CCB ADDRESS                10520168
* * *  NEED  AND ABOVE 32 K                                             10520169
       LA    12,2(12)                   ADD 2 TO GET RETURN ADDRESS     10520170
       STH   12,38                      STORE RETURN ADDRESS            10520171
       NC    0(5,13),SYSXZA             ZERO LINK AND COMMUNICATIONS    10520172
SYSQDE   TM    2(13),X'04'              SHOULD THIS CCB WAIT FOR DEV E  10520173
         BC    8,SYSAAA                 BYPASS STASH IN WAITING LIST    10520174
* * *    PUSH DOWN LIST OF DEVICES SIG AT DEV END                       10520175
       STH   13,SYSVCB                  STORE CCB ADDRESS               10520176
         MVC   SYSA01(SYSLNG),SYSA01+2       PUSH DOWN LIST             10520177
SYSAAA  EQU  *                                                          10520178
       STH   13,SYSVCB                  SAVE CCB ADDRESS                10520179
       LH    13,4(13)                    LOAD SYMBOLIC ADDRESS          10520180
       SR     12,12                     ZERO REGISTER                   10520181
       IC    12,SYSUTB(13)              PULL CHANNL                     10520182
       AR     12,12                     DOUBLE CHANNEL                  10520183
       OC    SYSUSE(1),SYSXCN-SYSS00(12) SET CHANNEL USE BYTE           10520184
*            * * * PLACE CCB AT END OF Q AND LINK * * *                 10520185
       LA    13,SYSQMX(12)              LOAD ADDRESS OF HEAD OF Q       10520186
SYSQLL CLI   0(13),X'00'                TEST CORE FOR BLANK ADRESS      10520187
       BC    8,SYSQLK                   END OF Q   SO PASS TO STORE CCB 10520188
       LH    13,0(13)                   PULL LINKAGE ADDRESS            10520189
     B       SYSQLL                                                     10520190
SYSQLK MVC   0(2,13),SYSVCB               PUT THIS CCB AT END OF Q      10520191
       CLI   SYSXPT-SYSS00(12),X'07'    EXPECT INTERRUPT THIS CHANNEL Q 10520192
       BNE   SYSXST                     EXIT SUPVR IF NOW EXPECT INTRPT 10520193
SYSQST MVC   56(8),32                                                   10520194
*            * * * START I/O FOR THIS Q      * * *                      10520195
SYSUA1 LH    13,SYSQMX-SYSS00(12)       PULL HEAD OF Q CCB ADDR         10520196
       MVC   74(2),6(13)                PULL CCW ADDR INTO CAW          10520197
       LH    13,4(13)                   LOAD SYMBOLIC ADDRESS           10520198
         CLI   SYSUTB-SYSS00+2(13),X'00'     IS THIS DEVICE A TAPE      10520199
         BNE   SYSWF1                   BRANCH IF NOT                   10520200
         NI    SETMOD,X'03'             SET MODE BITS OFF               10520201
         OC    SETMOD(1),SYSUTB-SYSS00+3(13)      SET MOD ON            10520202
         MVC   SYSTIC+2(2),74          PLACE CCW INTO TIC               10520203
         MVC   74(2),ADSTMD+2           PLACE SET MODE ADDR INTO CAW    10520204
SYSWF1   LH    13,SYSUTB(13)            PUT CHNL, DEVICE IN REGISTER    10520205
SYSWFH   B       SYSWIO            BYPASS WOIT                          10520206
       MVI   SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10520207
         MVI     SYSXWW+1,X'00'                                         10520208
         TIO     0(13)             CHECK CHANNEL END                    10520209
         BC      6,*-4             WAIT FOR DEVICE END                  10520210
*            * * * START I/O ROUTINE    * * *                           10520211
SYSWIO SIO   0(13)           START IO                                   10520212
       STH   13,58                      IF CSW STORED NEED CH/UN ADRES  10520213
       BC    7,*+8            BYPASS SET EX PECT                        10520214
       STH   13,SYSXPT-SYSS00(12)       MOVE CHNL,DEVICE TO 5XP53T 9N3  10520215
       BC    10,SYSXWW                  GET OUT IF CC IS 0,2            10520216
       BC    1,SYSXMN                   OVERFLO FOR NOT OPERATIONAL     10520217
         NI    SYSUIS+1,X'0F'           IMMEDIATE END                   10520218
       TM    68,X'10'                   DEVICE BUSY                     10520219
       BC    12,SYSXBB                  NO SO ERR OR IMMED END          10520220
       TM    68,X'04'                   DEVICE END                      10520221
       BC    1,SYSWIO                   TRY AGAIN D.E INT WAS PENDING   10520222
SYSXWW BC    15,SYSXIT                  BUSY BUT NO END SAYS TRY LATER  10520223
       TIO   0(13)                                                      10520224
       BC     2,*-4              WAIT FOR CHANNEL END                   10520225
       BC    15,SYSXBB                  END OF WAIT,CHECK ERRORS        10520226
*            * * * I/O INTERRUPT                                        10520227
SYSXIN SR     12,12                     ZERO REGISTER                   10520228
         OI    SYSUIS+1,X'F0'           I/O INTRPT  NOT INISL SELECTION 10520229
       IC    12,58                       INSERT CHANNEL                 10520230
       AR    12,12                      DOUBLE CHANNEL                  10520231
SYSXCK CLC   SYSXPT-SYSS00(2,12),58      EXPECT INTRUPT THIS CH,DEVICE  10520232
      BC  7,SYSXAT       TEST ATTENTION ETC                             10520233
* * *  ANALYSE FOR ERRORS, INTERRUPT OR CSW STORED                      10520234
SYSXBB LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS FOR SET ERR FL 10520235
       TM    69,X'3F'                   TEST CHNNL,DATA,CONTROL,INTFACE 10520236
       BC    7,SYSQCC                   CHANNNEL ERRORS HARD STOP       10520237
SYSXCC TM    68,X'01'                   TEST UNIT EXCEPTION,END FILEETC 10520238
       BC    8,SYSXUC                   BR TO UNIT TEST UNIT CHECK      10520239
       OI    3(13),X'04'                TURN ON UNIT EXCEPTION          10520240
SYSXUC TM    68,X'02'                   UNIT CHECK                      10520241
       BC    7,SYSWUC                   YES,GO TO WORK UNIT CHECK       10520242
* * *  NO ERRORS ASSUME CHANNEL END                                     10520243
SYSUDE TM    68,X'04'                   DEVICE END                      10520244
       BC    8,SYSWUP                   NO LEAVE IT IN LITST            10520245
       OI    3(13),X'01'                SET END  DEV END BIT            10520246
SYSWUP BC    0,SYSQXC                   ER RTN CUT Q BY BRANCH HERE     10520247
       TM    69,X'80'                   PROG  CONTR INTR                10520248
       BC    8,SYSPST             NO CONTINUE                           10520249
         OI    4(13),X'80'              TURN PCI BIT ON                 10520250
         TM    69,X'08'                 CHANNEL END                     10520251
         BNE   SYSXIT                                                   10520252
SYSPST OC    2(1,13),69                 OR IN WLR,PCI  BITS             10520253
       OI    2(13),X'80'                POST TRAFFIC BIT                10520254
SYSUPD MVI   SYSXPT-SYSS00(12),X'07'    SAY CHNL NOT EXPECT INTERRUPT   10520255
       MVC   SYSQMX-SYSS00(2,12),0(13)  MOVE NEXT TO HEAD OF Q          10520256
       MVC   0(2,13),70                 PUT RESIDUAL COUNT IN CCB       10520257
SYSQTT CLI   SYSQMX-SYSS00(12),X'00'     IS Q EMPTY                     10520258
       BC    6,SYSUA1                   NO,TRY TO START I O             10520259
       NC    SYSUSE(1),SYSXCN+1-SYSS00(12) CLEAR BIT IN CHANNEL USE BY  10520260
SYSXIT LPSW  56                         RETURN VIA LOAD OLD PSW         10520261
SYSXRS XC    SYSQMX(8),SYSQMX           TURN Q A TO ZERO                10520262
       MVI   SYSXPT,X'07'               NOT EXXECT ON MPX CHANNEL       10520263
       MVC   SYSXPT+1(7),SYSXPT         NOT EXPECT ON ANY CHNNL         10520264
       MVI   SYSUSE,X'00'               SET CHANNEL ACTIVITY TO ZERO    10520265
SYSVRR MVI   SYSWUP+1,X'00'             NOP ERR I/O RETURN IF ERR CH OK 10520266
         MVI     SYSXWW+1,X'F0'         RESET BRANCH AFTER SIO          10520267
       MVI   SYSQXR+1,X'F0'             SET SWITCH TO BR AS NORMAL      10520268
       MVI   SYSWFH+1,X'F0'             SET SW TO BRANCH                10520269
       CLI   SYSWFF+1,X'00'  '             IS SWITCH TO BRANCH          10520270
       BCR   8,13                       NO, RETURN                      10520271
         LM    1,11,SYSVRX              RESTORE REGISTERS               10520272
       MVI   SYSWFF+1,X'00'             SWITCH TO SAVE PSW              10520273
       BCR   15,13                     RETURN                           10520274
*            * * * TEST UNIT CHECKS     * * *                           10520275
SYSWUC OI    2(13),X'20'                SET UNCORRECTABLE ERROR BIT CCB 10520276
       TM    2(13),X'01'                USER ERROR RTN                  10520277
       BC    1,SYSWUP                   YES,RETURN TO USER              10520278
SYSWFF BC    0,SYSXFF                   BYPASS SAVE PSW AND STATUS      10520279
SYSVRZ   STM   1,11,SYSVRX              SAVE REGISTERS FOR WORK         10520280
       LM    1,5,SYSAVE       SAVE CORE BY REG   BCR  * * *             10520281
       MVI   SYSQCT,X'0'                SERO ERROR COUNTER              10520282
SYSXFF OI    SYSWFF+1,X'F0'              TURN ON SWITCH TO BYPASS SAVE  10520283
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10520284
       LH   11,66                       NEXT CCW     INTO REG           10520285
         SH   11,SYSC08                SUBTRACT 8 TO GET LAST CCW       10520286
       STH  11,66         SAVE NEW CCW IN CORE                          10520287
       MVC   SYSVCW(12),64               SAVE CSW,   CAW                10520288
       MVI     50,X'1F'                 1F  FOR UNIT CHECK              10520289
       XC    SYSENS(6),SYSENS           SET SENSE TO ZERO               10520290
       LH    9,58                                                       10520291
       MVC   74(2),SYSXSC                SENSE CCW                      10520292
       SIO   0(9)                       SENSE                           10520293
         BC    6,*-4                                                    10520294
* * * *      ASSUMED  NO ERRORS ON SENSE  SINCE UNIT CHECK SAYS CONTR   10520295
* * * *                UNIT IS OPERATIONAL                              10520296
* * * *      ASSUME  NO OUTSTANDING INTRPS SINCE GOT SOME KIND OF ENDA  10520297
* * * *              SHORT WHILE BACK                                   10520298
       TIO   0(9)                                                       10520299
       BC   2,*-4            WAIT FOR END OF SENSE                      10520300
       MVC   64(12),SYSVCW                   RESTORS   CSW  CAW         10520301
       IC    8,SYSQCT                   READY TO STEP COUNTER           10520302
SYSCSP LA    8,1(8)                     ADD ONT TO COUNTER              10520303
       STC   8,SYSQCT                   PUT CNTR IN CORE                10520304
       LH     8,4(13)                   PULL SYMBOLIC UNIT              10520305
       IC     8,SYSUTB+2(8)              PULL DEVICE TYPE               10520306
       LH    8,SYSXTE(8)               PULL TABLE ADDRESS               10520307
       BCR   15,8                                                       10520308
SYSQCC MVI   50,X'0F'                   CHANNEL ERROR                   10520309
       LPSW   112                       SIMULATE MACH CHECK             10520310
SYSXMN   MVI     50,X'3F'          NOT OPERATIONAL  3F                  10520311
       LH    13,SYSQMX(12)              PULL CCB ADDRESS                10520312
*            * * * DISTASTER OR DUMP EXIT * * *                         10520313
SYSQXD OI    2(13),X'20'                DISASTER BIT                    10520314
       TM    2(13),X'10'                ACCEPT BAD I/O                  10520315
       BC    1,SYSQXK                   YES  CONTINUE  NO CLEAR DISAST  10520316
* * *  DISASTER BIT ONLY BELONGS ON IF BITS X'11' I(13) ARE ON * * * *  10520317
       LPSW    112                                                      10520318
* * *  OPERATOR CHOICE EXIT                                             10520319
SYSQXP UNPK  SYSHLD(5),58(3)            PUT CH/UN REL                   10520320
SYSC08   EQU   *-4                     CONSTANT OF 8                    10520321
       UNPK  SYSHLD+4(5),SYSENS(3)      UNPACK SENSE INFO               10520322
       TR    SYSHLD(8),SYSTBL-240       CONVERT HEX TO CHARACTER FOR PR 10520323
       MVC   SYSXM1(4),SYSHLD           SET MESSG1 FOR MACRO            10520324
       MVC   SYSXM2(4),SYSHLD+4         SET MESSG2 FOR MACRO            10520325
         STM   12,13,SYSDRG             SAVE REGISTERS SINCE SUP USES T 10520326
       SVC   2           CALL VOR MESSAGE                               10520327
SYSXM1   DC    C'CHUN  '                CHANNEL AND UNIT MESSAGE        10520328
       SVC   2           CALL FOR MESSAGE                               10520329
SYSXM2   DC    C'SENSA '                SENSE MESSAGE                   10520330
         LM    12,13,SYSDRG             RESTORE SAVED REGISTER S        10520331
         CH    12,SYSXCK+4                                              10520332
         BC    2,SYSQXC                                                 10520333
       CLI   SYSXM2+5,C'5'              IS REPLY RETRY                  10520334
* * *  RETRY EXIT                                                       10520335
       BC    8,SYSQXR                   GO TO RTN                       10520336
*            * ** CONTINUE EXIT         * * *                           10520337
SYSQXC NI    2(13),X'DF'                TURN OFF DISASTER BIT           10520338
SYSQXK CLI   SYSQXR+1,X'00'             WAS THIS I/O FROM RROR RTN      10520339
SYSXEE   MVI     SYSQXR+1,X'F0'    SWITCH FOR RESET OPER  SET IT TO BR  10520340
          BC     8,2(10)                   RETURN TO ERR RTN            10520341
       BAL   13,SYSVRR                 RESTORE REGISTERS                10520342
SYSWDE BC  0,SYSPDE                                                     10520343
       LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS F              10520344
       BC    15,SYSWUP                  UPDATE AND CONTINUE             10520345
SYSQXR BC    15,SYSUA1                  NORMAL RETRY                    10520346
SYSQXS MVC   74(2),0(10)                LOAD CAW                        10520347
       LH    13,58          SET UP CHANNEL,UNIT ADDRESS                 10520348
       OI    SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10520349
         MVI     SYSQXR+1,X'00'    SWITCH FOR RESET OPER  NOP           10520350
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10520351
       BC    15,SYSWFH+4                USE  NORMAL START AND TESTS     10520352
SYSSOF   TM    2(13),X'02'              TEST SELECTED ERROR BIT         10520353
         BCR   8,1                      EXIT IF NOT ON                  10520354
         B     SYSXEE                  CONTINUE IF ON                   10520355
SYSXAT   EQU  *                                                         10520356
SYSUNX   LA    12,SYSVCB                 INITIALIZE SEARCH FOR DEV END  10520357
SYSAL1   SH    12,SYSC02                 SUBTRACT 2                     10520358
         CLI   0(12),X'00'              NO CCB                          10520359
         BE    SYSA00                   NONE TRY TESTING Q              10520360
         LH    13,0(12)                 PULL CCB                        10520361
         LH    13,4(13)                 PULL SYMBOL UNIT                10520362
         CLC   SYSUTB-SYSS00(2,13),58   COMPARE INTR CR/UNIT/S CCB C/UN 10520363
         BNE   SYSAL1                   NOT THIS DEVICE                 10520364
         MVI   SYSWUP+1,X'F0'           CUT AT END OF CHECKS            10520365
         MVI   SYSWDE+1,X'F0'           RETURN HERE  DEV END SWITCH     10520366
         LH    13,0(12)                 SET CCB                         10520367
         B     SYSXBB+4                 SIGNIF.INT-CHECK CONDITIONS W/R 10520368
SYSPDE   MVI   SYSWDE+1,X'00'           NOP  DEV END SW                 10520369
         LH    13,0(12)                                                 10520370
         OI    3(13),X'01'                                              10520371
         SH    12,SYSC02                POP UP LIST                     10520372
         MVC   2(2,12),0(12)            UPDATE OUTSTANDING D.E POSSIBLE 10520373
         CLI   0(12),0                  END OF SIG LIST                 10520374
         BNE   SYSPDE+4                 POP UP THE LIST                 10520375
SYSA00   SR    12,12                    SET REG 12 IF ANY SEL CH S POIN 10520376
       IC    12,58                       INSERT CHANNEL                 10520377
       AR    12,12                      DOUBLE CHANNEL                  10520378
SYSQTS CLI   SYSXPT-SYSS00(12),X'07'    AT DEVICE END  NEED TO TST EXPT 10520379
       BC    4,SYSXIT                   LESS,REALL CHANNEL NUMBER       10520380
     B     SYSQTT                                                       10520381
* * *    CHECK DEVICE END                                               10520382
SYSC02 DC  H'2'                                                         10520383
* * *    DESIGNED FOR PRTOV MACRO                                       10520384
       DC  H'0'                                                         10520385
SYSA01 DC   2H'0'                       PUSH DOWN LIST FOR DVE SIG CCB  10520386
       DC   2H'0'                                                       10520387
LAST   DC   2H'0'                                                       10520388
SYSVCB DC    H'0'                                                       10520389
L      EQU   SYSVCB-SYSA01              LINGTH OF PUSH DOWN LIST        10520390
SYSLNG EQU   SYSVCB-SYSA01              LENGTH OF PUSH DOWN LIST        10520391
* * *    IF DEVICE END SIGNIFIGANT, TEST CH9,CH12,WITH I/O ERROR RTNS.  10520392
SYSXZA DC    X'00001F000F'              MASK,AND BYTES 0-3 OFF          10520393
SYSQCT DC    X'0'                  COUNTER FOR ERROR ROUTINES           10520394
*      TABLE  OF ERROR ENTRYS           * * *                           10520395
SYSXTE DC   Y(SYSTER)           TAPE ERROR RTN                          10520396
       DC      Y(SYSUIS)                1052 TYPEWRITER  ERROR          10520397
       DC      Y(SYSUAA)                1442 READ/PCH   ERROR           10520398
       DC      Y(SYSUCG)                1403 PRINTER    ERR/R           10520399
       DC      Y(SYSUCD)                1402  READER    ERR/R           10520400
       DC      Y(SYSUCC)                1402 PUNCH,PFR  ERR/R           10520401
       DC     Y(SYSD10)           DISK ROUTINES                         10520402
       DC      Y(SYSUKA)                1015 ERROR ROUTINES             10520403
       DC      Y(SYSP00)                2671 ERROR ROUTINES             10520404
       DC      Y(SYSUAB)                1443 PRINTER   ERROR            10520405
SYSUKA EQU   SYSQXD                     NO 1015 ERROR ROUTINES          10520406
SYSD10   EQU   SYSQXD                                                   10520407
SYSP00 EQU   SYSQXD                     NO 2671 ERROR ROUTINES          10520408
SYSXSC DC      Y(SYSXSN)                ADDR OF SENSE CCW               10520409
*                                                                       10520410
SYSQMX DC    3H'0'                      HEAD Q FOR MULTPLX,2SEL         10520411
SYSMSG   DC      Y(SYSSCB-2)           POINT TO CCB FOR SVC2            10520412
SYSXCN DC    X'807F'                    OR CH USE BYTE    AND IT OFF    10520413
       DC    X'40BF'                    OR CH USE BYTE    AND IT OFF    10520414
       DC    X'20DF'                    OR CH USE BYTE    AND IT OFF    10520415
SYSXPT DC    3X'0700'                   EXPECT INTERRUPT ON CHANNL      10520416
       DC     X'0700'                                                   10520417
***   AREA FOR SAVING REGISTERS                                         10520418
SYSVRX   DS    11F                      ROOM TO SAVE REMAINING REG.     10520419
SYSDRG   DS    D                                                        10520420
SETMOD   CCW   X'03',SETMOD,X'60',80     SET MODE COMMAND               10520421
SYSTIC   DC    X'08000000'              TIC COMMAND                     10520422
ADSTMD   DC      A(SETMOD)              ADDRESS OF SET MODE COMMAND     10520423
       DC  X'00FAFBFCFDFEFF00'          TRANSLATE LETT5RS 256OR5 G+     10520424
SYSXSN CCW   X'04',SYSENS,X'20',6       SENSE BYTES I/O CCW             10520425
SYSVCW   DC    3F'0'                                                    10520426
SYSAVE DC    A(SYSQXD)                  EXIT   DISASTER                 10520427
       DC    A(SYSQXC)                  EXIT   CONTINUE                 10520428
       DC    A(SYSQXR)                  EXIT   RETRY                    10520429
       DC    A(SYSQXP)                  EXIT   OPERATOR CHOICE          10520430
       DC    A(SYSQXS)                  EXIT   START I/O FOR ADJ BACKSP 10520431
SYSTBL DC    CL16'0123456789ABCDEF'            TABLE LOOK UP FOR HEX TR 10520432
*        **********  /360 TAPE ERROR ROUTINE  **********                10520433
         DS    0D                      START PROGRAM ON DOUBLE WORD     10520434
SYSTOS   EQU   6                       EQU TO GEN REG 6                 10520435
SYSTOT   EQU   7                       EQU TO GEN REG 7                 10520436
SYSTIO   EQU   10                      EQU TO GEN REG 10                10520437
SYSTIA   EQU   11                      EQU TO GEN REG 11                10520438
SYSTOP   EQU   13                      EQU TO GEN REG 13                10520439
SYST22   DC    X'2700000140000001'     BACKSPACE CCW + CHAIN FLAG       10520440
SYST33   DC    X'1700000100000001'     ERASE GAP CCW                    10520441
SYST44   DC    X'3700000100000001'     FWD, BKSP OR NOP CCW             10520442
SYST55   CCW   X'04',SYST66,X'20',2    SENSE CCW                        10520443
SYST66   DC    H'0'                    SENSE READ IN AREA               10520444
SYSTER   TM    SYSENS,X'FF'            ANY SENSE DATA                   10520445
         BCR   8,SYSUXC                                                 10520446
         MVI   SYST44,X'27'            MODIFY CCW TO BKSP               10520447
         TM    SYSENS,X'22'            BUS OUT CHECK OR WORD COUNT ZERO 10520448
         BC    5,SYST10                                                 10520449
         BAL   SYSTIO,SYSTSE           GO TO SUB-ROUT.--EQUIP + INT REQ 10520450
         MVN   SYST44+3(1),0(SYSTIA)   GET OP CODE FROM CCW COMMAND     10520451
         NI    SYST44+3,X'07'          REMOVE MOD BIT IF RD BKWD COMMD  10520452
         TM    SYSENS,X'0C'            TEST FOR DATA OR OVERRUN CHECK   10520453
         BC    7,SYST01                                                 10520454
         TM    3(13),X'08'              TEST DATA CONVERTOR             10520455
         BZ    SYST11                   NO                              10520456
         OI    3(SYSTOP),X'08'          SET DATA CONVERTOR              10520457
       BR      SYSUXC                                                   10520458
SYST01   CLI   SYST44+3,X'04'          IS THIS A RD BKWD COMMAND        10520459
         BC    7,SYST02                NO,                              10520460
         MVI   SYST44,X'37'            YES, MODIFY CCW TO FRDSPACE      10520461
SYST02   TM    SYSENS,X'04'            IS THIS AN OVERRUN CONDITION     10520462
         BO    SYST03                  YES                              10520463
         TM  SYSENS+1,X'80'             NOISE RECORD                    10520464
         BC   1,SYSTXY                                                  10520465
         LH    7,6(11)                  PLACE ORIG CT IN 7              10520466
         SH   7,70    SUB  RESID  CT                                    10520467
         LA    6,12                                                     10520468
         CR    7,6                                                      10520469
         BCR   4,SYSUXR                 RETRY  NOISE REC IF CT LESS 12  10520470
SYSTXY   CLI   SYST44+3,X'01'          IS THIS A WRITE OPER             10520471
         BZ    SYST05                  YES                              10520472
         TM    SYSQCT,X'07'            HAS 8 ATTEMPTS BEEN TRIED        10520473
         BZ    SYST06                  YES                              10520474
         TM    SYSENS+1,X'10'          IS THIS A 7 TRACK OPER           10520475
         BO    SYST03                  YES                              10520476
         TM    SYSENS+2,X'FF'          HAS TRACK IN ERROR BEEN IDENT    10520477
         BC    7,SYST03                NO                               10520478
         BALR  SYSTIO,SYSUXS                                            10520479
         DC      Y(SYST44)                REQUEST EXECUTED              10520480
         MVI   SYST44,X'1B'            MODIFY CCW OP TO REQUEST TIE     10520481
SYST03   CLI   SYSQCT,100                                               10520482
         BC    10,SYST04               YES                              10520483
         BALR  SYSTIO,SYSUXS                                            10520484
         DC      Y(SYST44)                REQUEST EXECUTED              10520485
SYSTBS   STH   SYSTIA,SYSTDC            CCW ADDRESS IS PLACED IN RETURN 10520486
         BALR  SYSTIO,SYSUXS                                            10520487
SYSTDC   DC      Y(SYSTDC)              WITH NEW CCW                    10520488
       BR    SYSUXC                     CONTINUE                        10520489
SYST04   TM    SYSENS,X'04'            TEST FOR OVERRUN CONDITION       10520490
         BCR   1,SYSUXD                                                 10520491
         OI    3(SYSTOP),X'10'          SET UNCORRECTABLE RD ERR        10520492
         B     SYSSOF                                                   10520493
SYST05   BALR  SYSTIO,SYSUXS                                            10520494
         DC      Y(SYST22)                ERASE GAP                     10520495
         CLI   SYSQCT,4                TEST FOR 3 WRITE ATTEMPTS        10520496
         BCR   4,SYSUXR                                                 10520497
         MVI   SYSENS+1,X'F3'          INIT '3 WRITE ERRORS' MESSG.     10520498
         BR    SYSUXD                                                   10520499
SYST06   MVI   SYST44,X'27'            ROUTINE                          10520500
         LA    SYSTOS,3                 TO                              10520501
         LH    SYSTOT,SYST44+2           INCORPORATE                    10520502
SYST07   BALR  SYSTIO,SYSUXS                                            10520503
         DC      Y(SYST44)                 CLEANING                     10520504
         BALR  SYSTIO,SYSUXS                                            10520505
         DC      Y(SYST55)                   WHEN                       10520506
         TM    SYST66+1,X'08'                 EVER                      10520507
         BO    SYST08                          8                        10520508
         BCT   SYSTOS,SYST07                    READ                    10520509
SYST08   XI    SYST44,X'10'                      ERRORS                 10520510
         SR    SYSTOT,SYSTOS                      ARE                   10520511
         BCR   8,SYSUXR                                                 10520512
SYST09   BALR  SYSTIO,SYSUXS                                            10520513
         DC      Y(SYST44)                                              10520514
         BCT   SYSTOT,SYST09                                            10520515
         B     SYSTBS                  EXIT TO RETRY                    10520516
SYST10   CLI   SYSQCT,3                TEST COUNTER FOR 3 ATTEMPTS      10520517
         BCR   10,SYSUXD                                                10520518
         TM      SYSENS,X'02'           READ CT ZERO                    10520519
         BCR   1,SYSUXR                                                 10520520
         CLI   SYST44+3,X'01'          IS COMMAND A WRITE OPER          10520521
         BCR   7,SYSUXR                                                 10520522
         B     SYST03                                                   10520523
SYST11   CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10520524
         CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10520525
         BCR   8,SYSUXD                                                 10520526
         BR    SYSUXP                                                   10520527
*                                                                       10520528
SYSUXD EQU   1         REGISTER 1     DISASTER                          10520529
SYSUXC EQU   2           REGISTER 3  NO ERROR  CONTINUE                 10520530
SYSUXR EQU   3           REGISTER 3  RETRY THE LAST CCB                 10520531
SYSUXP EQU   4          GREGISTER 4   OPERATOR CHOICE                   10520532
SYSUXS EQU   5           REGISTER 5  ROUTINE FOR RESET,BACKSPACE,ETC    10520533
SYSTSE   TM      SYSENS,X'10'      EQUITMENT CHECK                      10520534
         BCR     1,SYSUXD                                               10520535
SYSTSO   TM      SYSENS,X'40'      OPERATIO INTERVENTION                10520536
         BCR     1,SYSUXP          GO TO OPERATIO  CHOICE               10520537
         BR    10                                                       10520538
***** ERROR ROUTINE FOR PRINTERS,READERS AND PUNCH FOR TAPE SYSTEM ***  10520539
SYSTSU   TM    SYSENS,X'58'                                             10520540
         BCR   5,SYSUXP                                                 10520541
SYSUBT TM    SYSENS,X'20'               BASIC TEST ROUTINE     BUSS OUT 10520542
       BC    1,SYSUIS                   BUS OUT,SWITCH FOR RETRY        10520543
       TM    SYSENS,X'80'               COMMAND REJECT                  10520544
       BCR   1,SYSUXD                   GO TO DISASTER                  10520545
       BR    10                         NONE OF THESE  RETURN TO DEV RT 10520546
***** ENTER ROUTINE HERE FOR 1402 PUNCH ERROR *****                     10520547
SYSUCC TM    SYSENS,X'10'               EQUIPMENT CHECK                 10520548
       BC    8,SYSUCD                   NO,USE 1402R ROUTINES           10520549
SYSUDA   OI    3(13),X'11'             SET BIT IN CCB                   10520550
         B     SYSSOF                   EXIT TO TEST SOFT ERR BIT       10520551
***** ENTER ROUTINE HERE FOR 1402 READER ERROR *****                    10520552
SYSUCD   NI    SYSUIS+1,X'0F'           KNOW CAN RETRY BUS OUT ON 1402  10520553
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10520554
SYSUDB   OI       3(13),X'08'     SET BIT IN CCB                        10520555
         BR    SYSUXC             BRANCH TO CONTINUE                    10520556
***** ENTER ROUTINE HERE IF 1403 OR 1404 ERROR *****                    10520557
SYSUCG BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10520558
       TM    SYSENS,X'02'               USUSUAL COMMAND SEQUENCE        10520559
       BC    1,SYSUDB                   USE POSTING RTN                 10520560
       OI    3(13),X'02'                SET CH 9 OVERFLOW BIT           10520561
         BC    15,SYSUDE                CONTINUE                        10520562
***** ENTER ROUTINE HERE IF 1442,2520 OR 2501 ERROR *****               10520563
SYSUAA BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10520564
         BR      SYSUXP           BRANCH TO OPERATOR CHOICE             10520565
***** ENTER ROUTINE HERE FOR 1443         ERROR *****                   10520566
*      1403  ALSO- COULD B UCG+4 * * *                                  10520567
SYSUAB   NI   SYSENS,X'F3'                                              10520568
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10520569
         TM    SYSENS,X'01'                                             10520570
         BCR   8,SYSUXC                                                 10520571
       OI    3(13),X'02'                SET BIT IN CCB                  10520572
         BC    15,SYSUDE                                                10520573
***** ENTER ROUTINE HERE FOR 1052 ERROR ALSO COMMON BUS-OUT ROUTINE     10520574
SYSUIS BCR   15,SYSUXP                  OPERATOR CHOICE IF COMMAND EXEC 10520575
       CLI   SYSQCT,3                   TRIED 3 TIMES                   10520576
       BCR   12,SYSUXR                  RETRRY                          10520577
       BR    SYSUXP                     OPERATIOR CHOICE                10520578
SYSSND EQU   *        ENS OF SUPERVISOR                                 10520579
*                                                                       10520580
ABSLUT     SVC   0                                                      10520581
SYSLDR EQU   ABSLUT                                                     10520582
READCD  EQU  ABSLUT                                                     10520583
           DC    YL2(CCCB)                                              10520584
       TM    CCCB+2,X'80'       WAIT FOR END                            10520585
       BZ   *-4                                                         10520586
TEXTCD     EQU   *                                                      10520587
       L     15,INPUT                  3 TESTS CHEAPER WITH REGISTER    10520588
       CL    15,CREP                                                    10520589
       BZ    REPRUT                                                     10520590
           L     14,INPUT+4              SET UP ADDRESS EITHER BR OR DA 10520591
       CL    15,CEND                                                    10520592
       BCR   8,14               END CARD, GOT TO ADDRESS                10520593
       CL    15,CTXT                                                    10520594
       BC    7,READCD                  NOT  ANDY LIGIT CZRD IGNORE IT   10520595
           LH    15,INPUT+10            COUNT                           10520596
TXTCNT  BCTR  15,0       REDUCE COUNT BY 1                              10520597
           STC   15,MOVETX+1                                            10520598
MOVETX     MVC   0(0,14),INPUT+16        MOVE DATA                      10520599
       B     READCD                                                     10520600
REPRUT TR    INPUT+6(6),SYSTBL-240      BYTE TO HEX   C1 = FA  ETC      10520601
       PACK  INPUT(5),INPUT+6(7)          ADDRESS TO HEX                10520602
       LA    14,INPUT+11                FROM ADDRESS  FIRST REPLACE     10520603
       LA    15,INPUT+16                INTO ADDRESS  FIRST REPLACE     10520604
REPLP  LA    14,5(14)                   ADD 5 TO FROM ADDRESS           10520605
       MVC   SAVE(4),0(14)              SAVE  4 BYTES                   10520606
       TR    SAVE(4),SYSTBL-240         BYTE TO HEX                     10520607
       PACK   0(3,15),SAVE(5)           PACK, DROP SIGN  ZONES          10520608
       LA    15,2(15)                   MODIFY INTO ADDR                10520609
       CLI   4(14),C','                 IS IT COMMA  LAST MUST BE BLANK 10520610
       BC    8,REPLP                    YES, MORE BYTES                 10520611
REPXT  SH    15,REPRUT+18               COUNT OF BYTES REPLACES         10520612
       L     14,INPUT                   ADDRESS OF FIRST BYTE           10520613
       B     TXTCNT                                                     10520614
SAVE   DC    X'00000000'    ROOM FOR PACK  ETC                          10520615
INPUT      DS    10D                                                    10520616
MSCCW3     DC    X'02'             READ                                 10520617
            DC   AL3(INPUT)                                             10520618
           DC    A(80)                                                  10520619
CTXT       DC    X'02E3E7E3'                                            10520620
CEND       DC    X'02C5D5C4'                                            10520621
CCCB       DC    F'0'                                                   10520622
           DC    H'4'                                                   10520623
           DC    YL2(MSCCW3)                                            10520624
CREP   DC    X'02'                                                      10520625
       DC    C'REP'                                                     10520626
JOBCT      LPSW  SYSSLB                                                 10520627
       END  JOBCT                                                       10520628
         TITLE 'JOB CONTROL'                                            10520629
NRSUP    START 0                                                        10520630
         USING *,0,4                                                    10520631
SJW4RG   EQU   1                                                        10520632
SJCCRG   EQU   2                        CARD INDEX REGISTER             10520633
SJCTRG   EQU   4                        COUNTING REGISTER               10520634
SJW1RG   EQU   5                        WORK REGISTER                   10520635
SJW2RG   EQU   6                        WORK REGISTER                   10520636
SJW3RG   EQU   7                        WORK REGISTER                   10520637
SJTBRG   EQU   8                        TABLE INDEX REGISTER            10520638
SJCRRG   EQU   9              CONTAINS ADDR OF START OF COMMUNICAT REG  10520639
SJFBRG   EQU   10                  CONTAINS ADDR OF FILL BUCKET ROUTINE 10520640
SJSBRG   EQU   11                  CONTAINS ADDR OF SKIP BLANKS ROUTINE 10520641
SJBRRG   EQU   14                       SUBROUTINE ADDR REGISTER        10520642
SJLKRG   EQU   15                       RETURN LINKAGE REGISTER         10520643
SJCRJB   EQU   38                  JOB CONTROL BYTE IN COMMUN. REGION   10520644
SJCRJC   EQU   39                  JOB CONTROL BYTE IN COMMUN. REGION   10520645
SJCRUP   EQU   23                  UPSI BYTE                            10520646
SJCRCF   EQU   9                   CONFIGURATION BYTE                   10520647
SJCRMO   EQU   0                   MONTH-2 BYTES                        10520648
SJCRDA   EQU   2                   DAY-2BYTES                           10520649
SJCRYR   EQU   4                   YEAR-5BYTES                          10520650
SJCRNM   EQU   24                  NAME-6BYTES                          10520651
SJCRUS   EQU   20                                                       10520652
         ORG   NRSUP+4096                                               10520653
START    BALR  3,0                                                      10520654
         USING *,3                                                      10520655
         LH    SJCRRG,20     SET CRREG TO ADDR OF COMM. REGION          10520656
         LA    SJFBRG,SJFLBK       INIT REG TO ADDR OF FILL BUCKET ROUT 10520657
         LA    SJSBRG,SJSKBL       INIT REG TO ADDR OF SKIP BLANKS ROUT 10520658
         MVI   SJCRUP(SJCRRG),X'00'    ZERO UPSI BYTE                   10520659
         MVC   SJEOJM+6(6),SJCRNM(SJCRRG)        PUT NAME IN EOJ MESG   10520660
         TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10520661
         BC   14,SJNEOJ                      BRANCH NOT EQUAL           10520662
         TM    SJCRJB(SJCRRG),X'80'          IS LOG FLAG ON             10520663
         BC   14,SJNEOJ                                                 10520664
         MVI   SJEOJM,C'N'                   INIT FOR NORMAL EOJ  MSG   10520665
         TM    SJCRJB(SJCRRG),X'01'          WAS JOB ABORTED            10520666
         BC   14,SJTEOJ                                                 10520667
         MVI   SJEOJM,C'A'                   INIT FOR ABNORMAL EOJ MSG  10520668
SJTEOJ   SVC   0                             WRITE EOJ MESSAGE          10520669
         DC    YL2(SJECCB)                                              10520670
         TM    SJECCB+2,X'80'                                           10520671
         BC    8,*-4                                                    10520672
SJNEOJ   NI    SJCRJB(SJCRRG),X'80'          RESET ALL BUT LOG FLAG     10520673
         MVC   SJCRUS(3,SJCRRG),SJNUMT                                  10520674
SJREAD   SR    SJCTRG,SJCTRG                                            10520675
         SR    SJW1RG,SJW1RG                                            10520676
         SR    SJW2RG,SJW2RG                                            10520677
         SR    SJW3RG,SJW3RG                                            10520678
         SR    SJW4RG,SJW4RG                                            10520679
         BAL   SJLKRG,SJRDCD                                            10520680
         CLC   SJINPT(3),SJKCTL         TEST IF CONTROL CARD            10520681
         BNE   SJNOSL                  GO TO NO SLASH ROUTINE           10520682
         BAL   SJLKRG,SJDISP                                            10520683
         LA    SJCCRG,SJINPT+2                                          10520684
         BALR  SJLKRG,SJSBRG                                            10520685
         BALR  SJLKRG,SJFBRG                                            10520686
         SR    0,0                                                      10520687
         CLI   SJBUCK+5,C' '            IS VERB GREATER THAN 5 CHAR     10520688
         BNE   SJNOCC                                                   10520689
         CLI   0(SJCCRG),C','           DID COMMA FOLLOW THE VERB       10520690
         BE    SJNOCC                                                   10520691
SJNOBR   BC    0,SJVOL1                NOP-BRANCH SWITCH                10520692
         CLC   SJBUCK(5),SJKPAU         TEST FOR PAUSE CARD             10520693
         BE    SJPAUS                                                   10520694
         CLC   SJBUCK(4),SJKJOB         TEST FOR JOB CARD               10520695
         BE    SJJOB                                                    10520696
         CLC   SJBUCK(4),SJKLOG                                         10520697
         BE    SJLOG                                                    10520698
         CLC   SJBUCK(5),SJKNLG             TEST FOR NOLOG CARD         10520699
         BE    SJNLOG                                                   10520700
         TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10520701
         BZ    SJNOJC                                                   10520702
         LA    SJTBRG,SJTABL       SET REG TO BEGIN OF CTL CD TABLE     10520703
SJCCLU   CLC   2(5,SJTBRG),SJBUCK       COMPARE TABLE ENTRY             10520704
         BE    SJFND                                                    10520705
         CLC   2(5,SJTBRG),SJKASG       TEST FOR END OF TABLE           10520706
         BE    SJNOCC                                                   10520707
         LA    SJTBRG,7(SJTBRG)         INCREMENT FOR NEXT TABLE ENTRY  10520708
         B     SJCCLU                   LOOP FOR NEXT TABLE ENTRY       10520709
SJFND    MVC   SJBCK1(2),0(SJTBRG)                                      10520710
         LH    SJBRRG,SJBCK1            LOAD REG WITH ROUTINE ADDR      10520711
         BR    SJBRRG                   BRANCH TO ROUTINE               10520712
SJRDCD   LA    SJCCRG,SJINPT            INIT CONTROL CARD REGISTER      10520713
         SVC   0                                                        10520714
         DC    YL2(SJCCB)                                               10520715
SJRD1    TM    SJCCB+2,X'80'                                            10520716
         BC    8,SJRD1                                                  10520717
         TM    SJCCB+3,X'04'           TEST EOF                         10520718
         BC    1,SJRDCD                YES-LET IOCS ISSUE MESSAGE       10520719
         BR    SJLKRG                                                   10520720
SJSKBL   CH    SJCCRG,SJEOC            TEST FOR END OF CARD             10520721
         BCR   10,SJLKRG                                                10520722
         CLI   1(SJCCRG),C' '          COMPARE FOR BLANK                10520723
         BNE   0(SJLKRG)                RETURN                          10520724
         LA    SJCCRG,1(SJCCRG)                                         10520725
         B     SJSKBL                                                   10520726
SJFLBK   MVC   SJBUCK,SJ9BLK           BLANK BUCKET                     10520727
         AH    0,SJK01                                                  10520728
         LA    SJW1RG,SJBUCK                                            10520729
SJFB1    CLI   1(SJCCRG),C' '           TEST FOR BLANK                  10520730
         BE    SJBKFL                                                   10520731
         CLI   1(SJCCRG),C','           TEST FOR COMMA                  10520732
         BE    SJBKFL                                                   10520733
         CH    SJCCRG,SJEOC                                             10520734
         BCR   8,SJLKRG                                                 10520735
         CH    SJW1RG,SJEOB             TEST FOR OVERFLOW OF BUCKET     10520736
         BE    SJFB2                                                    10520737
         MVC   0(1,SJW1RG),1(SJCCRG)                                    10520738
         LA    SJW1RG,1(SJW1RG)                                         10520739
SJFB2    LA    SJCCRG,1(SJCCRG)                                         10520740
         B     SJFB1                                                    10520741
SJBKFL   LA    SJCCRG,1(SJCCRG)                                         10520742
         BR    SJLKRG                                                   10520743
SJCNVB   BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10520744
         BALR  SJLKRG,SJFBRG            FILL BUCKET                     10520745
         CLI   SJBUCK+8,C' '                                            10520746
         BNE   SJCCER                                                   10520747
         CLI   0(SJCCRG),C' '           DID BLANK STOP THE SCAN         10520748
         BNE   SJCCER                                                   10520749
         LH    SJCTRG,SJK008            SET COUNTER TO 8                10520750
         LA    SJTBRG,SJBUCK+7          SET REG TO END OF BUCKET ADDR   10520751
         SR    SJW2RG,SJW2RG            ZERO WORK REG                   10520752
SJCVB1   IC    SJW2RG,0(SJTBRG)         PUT ONE CHAR OF PARAM INTO REG  10520753
         CLI   0(SJTBRG),C'1'           IS CHAR A 1                     10520754
         BE    SJCVB2                                                   10520755
         SRL   SJW3RG,1                 SHIFT ODD REG INSERTING A ZERO  10520756
         B     SJCVB3                                                   10520757
SJCVB2   SRDL  SJW2RG,1            PUT A 1 IN HIGH ORDER OF ODD REG     10520758
SJCVB3   BCTR  SJTBRG,0                 SUBTRACT 1 FROM BUCKED ADDR REG 10520759
         BCT   SJCTRG,SJCVB1            LOOP 7 TIMES                    10520760
         SRL   SJW3RG,24           SHIFT HIGH BYTE TO LOW ORDER OF REG  10520761
         BR    SJBRRG                   RETURN TO CONFG OR UPSI ROUTINE 10520762
SJCONF   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10520763
         STC   SJW3RG,SJCRCF(SJCRRG)         STORE CONFG BYTE IN CR     10520764
         B     SJREAD                   GET NEXT CARD                   10520765
SJUPSI   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10520766
         STC   SJW3RG,SJUPSS+1         STORE CHAR IN MASK               10520767
SJUPSS   OI    SJCRUP(SJCRRG),0        OR UPSI CHAR TO UPSI BYTE        10520768
         B     SJREAD                                                   10520769
SJJOB    TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10520770
         BC    1,SJJOB1                      IF ON,GO TO ERROR          10520771
         BALR  SJLKRG,SJSBRG                 SKIP BLANKS                10520772
         BALR  SJLKRG,SJFBRG                 FILL BUCKET                10520773
         MVC   SJCRNM(6,SJCRRG),SJBUCK       MOVE NAME INTO CR          10520774
         OI    SJCRJB(SJCRRG),X'02'          SET JOB FLAG ON            10520775
         B     SJREAD                                                   10520776
SJJOB1   NI    SJCRJB(SJCRRG),X'FD'     RESET JOB CARD FLAG             10520777
         MVC   SJMESG+3(3),SJMSG1       SET UP MESSAGE FOR DOP JOB CARD 10520778
         B     SJMESG                                                   10520779
SJPAUS   TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10520780
         BC    8,SJPAU1                                                 10520781
         OI    SJCRJB(SJCRRG),X'04'     SET PAUSE FLAG ON               10520782
         B     SJREAD                                                   10520783
SJPAU1   MVC   SJMESG+3(3),SJPMSG       INIT PAUSE MESSAGE              10520784
         B     SJMESG                                                   10520785
SJEXEC   EQU   *                                                        10520786
         LH    SJW1RG,22     POINT REG TO SYSLST PUB                    10520787
         LA    SJW1RG,08(SJW1RG)                                        10520788
         NI    SJCRJC(SJCRRG),X'7F'    RESET PRINTER SW                 10520789
         CLI   2(SJW1RG),X'06'         IS SYSLST A PRINTER              10520790
         BE    SJSPS                                                    10520791
         CLI   2(SJW1RG),X'12'                                          10520792
         BNE   SJEXQ1                                                   10520793
SJSPS    OI    SJCRJC(SJCRRG),X'80'          SET PRINTER SW             10520794
SJEXQ1   CLI   SJCRDA(SJCRRG),X'00'     TEST IF DATE WAS SUBMITTED      10520795
         BE    SJNODC                                                   10520796
         TM    SJCRJB(SJCRRG),X'04'     TEST PAUSE FLAG                 10520797
         BC    8,SJEXQ2                                                 10520798
         SVC   2                             DELAYED PAUSE              10520799
         DC    C'1703A '                                                10520800
SJEXQ2   EQU   *                                                        10520801
SJEXQ3   LH    SJW3RG,20               GET                              10520802
         NC    SJLBKT(1),9(SJW3RG)     HIGHEST                          10520803
         LH    SJW3RG,SJKON8           CORE                             10520804
         IC    0,SJLBKT                LOCATION                         10520805
         SRL   0,5                                                      10520806
         STC   0,*+7                                                    10520807
         SLL   SJW3RG,0                                                 10520808
         BCTR  SJW3RG,0                                                 10520809
         MVI   0(SJW3RG),C'*'                                           10520810
SJLAB3   BC    0,SJMLAB                                                 10520811
SJEXQ6   CLI   19,X'00'                ARE ALL I/O FINISHED             10520812
         BNE   SJEXQ6                                                   10520813
         SVC   1                        FETCH PROGRAM                   10520814
SJEXQ4   DC    C'SYSBPD'                                                10520815
SJDATE   BALR  SJLKRG,SJSBRG            SKIP BLANKS IN CTL CARD         10520816
         BALR  SJLKRG,SJFBRG            FILL BUCKET WITH DATE           10520817
* TEST FOR NON-NUMERIC CHARACTER IN DATE FIELD                          10520818
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10520819
         NC    SJBCK1(5),SJK5F0         CONVERT BYTES TO XXXX0000       10520820
         CLC   SJBCK1(5),SJK5F0         TEST IF XXXX0000 ARE 11110000   10520821
         BNE   SJCCER                   IF NO THERE IS A NON NUMERIC    10520822
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10520823
         NC    SJBCK1(5),SJK50F         CONVERT BYTES TO 0000XXXX       10520824
         TRT   SJBCK1(5),SJNUMT         TEST IF ANY NUMBER IS NOT 0-9   10520825
         BC    6,SJCCER                                                 10520826
         CLI   SJBUCK+5,C' '       IS DATE FIELD LONGER THAN 5 CHAR     10520827
         BNE   SJCCER                                                   10520828
         CLI   SJBUCK+4,C' '            IS DATE LESS THAN 5 CHAR        10520829
         BE    SJCCER                                                   10520830
         MVC   SJCRYR(5,SJCRRG),SJBUCK       STORE 5 CHAR DATE IN CR    10520831
         PACK  SJBCK1(8),SJBUCK(2)      PACK THE YEAR                   10520832
         CVB   SJW1RG,SJBCK1            CONVERT TO BINARY THE YEAR      10520833
         MVI   SJFEB,X'1C'             SET FEB TABLE ENTRY TO 28 DAYS   10520834
         N     SJW1RG,SJKW3             AND 0003 TO TEST FOR LEAP YEAR  10520835
         BNE   SJDAT1                                                   10520836
         MVI   SJFEB,X'1D'              SET FEB TABLE ENTRY TO 29 DAYS  10520837
SJDAT1   PACK  SJBCK1(8),SJBUCK+2(3)    PACK THE DAY                    10520838
         CVB   SJW1RG,SJBCK1            CONVERT THE DAY TO BINARY       10520839
         XR    SJCTRG,SJCTRG                                            10520840
         LA    SJTBRG,SJMOTB-1     SET TABLE REGISTER TO ADDR OF MO T12 10520841
SJDAT2   LA    SJCTRG,1(SJCTRG)         ADD ONE TO MONTH COUNTER        10520842
         LA    SJTBRG,1(SJTBRG)         ADD 4 TO TABLE REG              10520843
         STC   SJW1RG,SJDAT             SAVE DATE                       10520844
         IC    SJW2RG,0(SJTBRG)                                         10520845
         SR    SJW1RG,SJW2RG            SUBTRACT MONTH VALUE FROM DATE  10520846
         BP    SJDAT2                   LOOP ON A PLUS RESULT           10520847
         CVD   SJCTRG,SJBCK1            CONVERT MONTH COUNT TO DEC      10520848
         UNPK  SJCRMO(2,SJCRRG),SJBCK1(8)         STORE MONTH IN CR     10520849
         IC    SJCTRG,SJDAT                                             10520850
         CVD   SJCTRG,SJBCK1            CONVERT DAY TO DEC              10520851
         UNPK  SJCRDA(2,SJCRRG),SJBCK1(8)         STORE DAY IN CR       10520852
         OI    SJCRMO+1(SJCRRG),X'F0'                                   10520853
         OI    SJCRDA+1(SJCRRG),X'F0'                                   10520854
         CLC   SJCRMO(2,SJCRRG),SJK12        IS MONTH MORE THAN 12      10520855
         BNH   *+14                                                     10520856
         MVC   SJCRMO(9,SJCRRG),SJNUMT       ZERO DATE FIELD            10520857
         B     SJCCER                                                   10520858
         B     SJREAD                                                   10520859
SJNODC   MVC   SJMESG+3(3),SJNDCM       SET UP MESSAGE FOR NO DATE CARD 10520860
         B     SJMESG                                                   10520861
SJSYSR   BALR  SJLKRG,SJFBRG            PUT SYS*** PARAM INTO BUCKET    10520862
         CLI   0(SJCCRG),C','           TEST FOR COMMA AFTER PARAM 1    10520863
         BNE   SJCCER                                                   10520864
         CLI   SJBUCK+6,C' '                                            10520865
         BNE   SJCCER                                                   10520866
         CLC   SJBUCK(3),SJKSYS                                         10520867
         BNE   SJCCER                                                   10520868
         LA    SJW4RG,4                 PUT DISP FOR SYSRDR IN REG      10520869
         CLC   SJBUCK+3(3),SJKRDR       TEST FOR SYSRDR                 10520870
         BCR   8,SJBRRG                 BRANCH EQUAL                    10520871
         LA    SJW4RG,4(SJW4RG)                                         10520872
         CLC   SJBUCK+3(3),SJKLST       SYSLST                          10520873
         BCR   8,SJBRRG                 BRANCH EQUAL                    10520874
         LA    SJW4RG,4(SJW4RG)                                         10520875
         CLC   SJBUCK+3(3),SJKIPT       SYSIPT                          10520876
         BCR   8,SJBRRG                 BRANCH EQUAL                    10520877
         LA    SJW4RG,4(SJW4RG)                                         10520878
         CLC   SJBUCK+3(3),SJKOPT       SYSOPT                          10520879
         BCR   8,SJBRRG                 BRANCH EQUAL                    10520880
         LA    SJW4RG,4(SJW4RG)                                         10520881
         CLC   SJBUCK+3(3),SJKLOG       SYSLOG                          10520882
         BCR   8,SJBRRG                 BRANCH EQUAL                    10520883
         CLI   SJBUCK+5,C' '                                            10520884
         BE    SJCCER                                                   10520885
         TM    SJBUCK+3,X'F0'           TEST FOR NON NUMERIC ERROR      10520886
         BC    14,SJCCER                                                10520887
         TM    SJBUCK+4,X'F0'                                           10520888
         BC    14,SJCCER                                                10520889
         TM    SJBUCK+5,X'F0'                                           10520890
         BC    14,SJCCER                                                10520891
         PACK  SJBCK1(8),SJBUCK+3(3)    PACK INTO FULL WORD             10520892
         CVB   SJW1RG,SJBCK1            CONV PUB NO TO BINARY           10520893
         LA    SJW1RG,1(SJW1RG)        ALLOW FOR PUB 000                10520894
         STC   SJW1RG,SJSYS1+1                                          10520895
         LH    SJW2RG,22                LOAD PUB ADDR IN WORK REG       10520896
SJSYS1   CLI   3(SJW2RG),X'00'          IS THIS PUB IN THIS SYSTEM      10520897
         BL    SJCCER                                                   10520898
         SLL   SJW1RG,2                 MULT PUB NO BY 4                10520899
         AR    SJW4RG,SJW1RG            ADD PUB DISP TO TABLE REG       10520900
         BR    SJBRRG                                                   10520901
SJASGN   BALR  SJLKRG,SJSBRG            SKIP BLANKS AFTER VERB          10520902
         BAL   SJBRRG,SJSYSR                                            10520903
         AH    SJW4RG,22                                                10520904
SJASG2   BAL   SJLKRG,SJFLBK                                            10520905
         XC    SJPUB(4),SJPUB                                           10520906
         CLC   SJBUCK(3),SJKUA         SHOULD PUB BE UNASSIGNED         10520907
         BE    SJASG5                  LOAD EMPTY PUB                   10520908
         CLC   SJBUCK+5(2),SJKQB        TEST IF PAR2 IS X'XXX'          10520909
         BNE   SJCCER                                                   10520910
         CLC   SJBUCK(2),SJKHEX                                         10520911
         BNE   SJCCER                                                   10520912
         CLI   SJBUCK+2,C'2'            IS CHAN GREATER THAN 2          10520913
         BH    SJCCER                                                   10520914
         MVC   SJPUB(1),SJBUCK+2        STORE CHAN IN TEMP PUB          10520915
         NI    SJPUB,X'0F'              CONV CHAN NUMBER TO BINARY      10520916
         MVC   SJBCK1(2),SJBUCK+3       PLACE HEX CHARS IN BUCKET       10520917
         BAL   SJLKRG,SJCVHB            GO TO CONV HEX TO BINARY ROUTIN 10520918
         STC   SJW2RG,SJPUB+1           STORE UNIT NO IN TEMP PUB       10520919
         BAL   SJLKRG,SJFLBK                                            10520920
         CLI   SJBUCK+2,C' '            TEST IF PARAM IS MORE THAN 2CH  10520921
         BNE   SJCCER                                                   10520922
         LA    SJTBRG,SJDTAB            SET TABLE REG TO DEVICE TAB     10520923
         LA    SJCTRG,12                                                10520924
SJASG3   CLC   SJBUCK(2),1(SJTBRG)      COMPARE TABLE ENTRY TO DEV TYPE 10520925
         BE    SJASG4                                                   10520926
         LA    SJTBRG,3(SJTBRG)         INCR TO NEXT TABLE ENTRY        10520927
         BCT   SJCTRG,SJASG3            LOOP TILL END OF TABLE          10520928
         B     SJCCER                                                   10520929
SJASG4   MVC   SJPUB+2(1),0(SJTBRG)     STORE CODE IN PUB               10520930
         CLI   0(SJCCRG),C' '           IS THERE A PARAM4               10520931
         BE    SJASG5                                                   10520932
         BALR  SJLKRG,SJFBRG            MOVE PARAM4 TO BUCKET           10520933
         CLC   SJBUCK(2),SJKHEX         TEST IF PAR4 IS X'XX'           10520934
         BNE   SJCCER                                                   10520935
         CLC   SJBUCK+4(2),SJKQB                                        10520936
         BNE   SJCCER                                                   10520937
         MVC   SJBCK1(2),SJBUCK+2       PLACE HEX CHARS IN BUCKET       10520938
         BAL   SJLKRG,SJCVHB            CONVERT HEX TO BINARY           10520939
         STC   SJW2RG,SJPUB+3           STORE ANS.IN TEMP PUB           10520940
SJASG5   MVC   0(4,SJW4RG),SJPUB        MOVE NEW ASSIGNMENT TO PUB      10520941
         B     SJREAD                                                   10520942
SJCVHB   LA    SJW1RG,SJBCK1+1          POINT REG TO 2ND HEX CHAR       10520943
         LA    SJCTRG,2                 SET COUNTER TO 2                10520944
SJCHBA   SR    SJW2RG,SJW2RG            ZERO WORK REGISTER              10520945
         IC    SJW2RG,0(SJW1RG)         PUT HEX CHAR IN WORK REG        10520946
         TM    0(SJW1RG),X'F0'          IS IT 1111XXXX                  10520947
         BC    14,SJCHB1                BRANCH IF NOT 1111XXXX          10520948
         B     SJCHB2                                                   10520949
SJCHB1   LA    SJW2RG,09(SJW2RG)                                        10520950
         CLI   0(SJW1RG),C'F'                                           10520951
         BH    SJCCER                                                   10520952
         CLI   0(SJW1RG),C'A'                                           10520953
         BL    SJCCER                                                   10520954
SJCHB2   SRDL  SJW2RG,4                 SHIFT GOOD BITS TO ADJACENT REG 10520955
         BCTR  SJW1RG,0                 POINT REG TO 1ST HEX CHAR       10520956
         BCT   SJCTRG,SJCHBA            LOOP ONCE                       10520957
         SLDL  SJW2RG,8            SHIFT BINARY BYTE TO REG FOR STC     10520958
         BR    SJLKRG                                                   10520959
SJNOJC   MVC   SJMESG+3(3),SJNJCM       MOVE MESSAGE FOR NO JOB CARD    10520960
         B     SJMESG                                                   10520961
SJNOSL   MVC   SJMESG+3(3),SJMSG3                                       10520962
         B     SJNOCC+6                                                 10520963
SJNOCC   TM    SJCRJB(SJCRRG),X'02'                                     10520964
         BZ    SJREAD                                                   10520965
         MVC   SJMESG+3(3),SJMSG2                                       10520966
         B     SJMESG                                                   10520967
SJCCER   MVI   SJMESG+3,C'3'            CONTROL CARD ERROR              10520968
         STH   0,SJMESG+4                                               10520969
         OC    SJMESG+4(2),SJK5F0                                       10520970
SJMESG   SVC   2                        TELL SUPV TO DISPLAY MESSAGE    10520971
         DC    C'1   '                  MESSAGE TO BE DISPLAYED         10520972
         DC    C'A'                    RESPONSE REQUESTED               10520973
         DC    C' '                     RESPONSE CHARACTER-NOT USED     10520974
         B     SJREAD        READ NEXT CARD                             10520975
SJLOG    TM    SJCRJB(SJCRRG),X'80'          TEST LOG FLAG              10520976
         BC    1,SJREAD                      IF ON EXIT                 10520977
         OI    SJCRJB(SJCRRG),X'80'          SET LOG FLAG ON            10520978
         BAL   SJLKRG,SJDISP                                            10520979
         B     SJREAD                                                   10520980
SJNLOG   NI    SJCRJB(SJCRRG),X'7F'          RESET LOG FLAG             10520981
         B     SJREAD                                                   10520982
SJDISP   TM    SJCRJB(SJCRRG),X'80'          TEST LOG SW                10520983
         BCR   14,SJLKRG                     EXIT IF OFF                10520984
*   SCAN CARD FROM COL 80 FOR NON-BLANK ,COMPUTE LENGTH FOR CCW         10520985
         LA    SJCCRG,SJINPT+79        COMPUTE LENGTH FOR DISPLAYING    10520986
SJDSP1   CLI   0(SJCCRG),C' '                                           10520987
         BNE   SJDSP2                                                   10520988
         BCT   SJCCRG,SJDSP1                                            10520989
SJDSP2   SH    SJCCRG,SJAIPT                                            10520990
         STH   SJCCRG,SJDCCW+6                                          10520991
         SVC   0                                                        10520992
         DC    YL2(SJDCCB)                                              10520993
         TM    SJDCCB+2,X'80'                                           10520994
         BC    8,*-4                                                    10520995
         BR    SJLKRG                                                   10520996
SJAIPT   DC    YL2(SJINPT-1)                                            10520997
SJFILE   BALR  SJLKRG,SJSBRG                                            10520998
         BAL   SJBRRG,SJSYSR                                            10520999
         STC   SJW1RG,SJTCCB+5               STORE PUB DISP IN CCB      10521000
         CLI   2(SJW2RG),X'00'               TEST FOR TAPE ASSGN IN PUB 10521001
         BNE   SJCCER                                                   10521002
         BALR  SJLKRG,SJFBRG                 GET 2ND PARAMETER          10521003
         CLC   SJBUCK(2),SJKHEX              TEST FORMAT- MUST BE X'HH' 10521004
         BNE   SJCCER                                                   10521005
         CLC   SJBUCK+4(2),SJKQB                                        10521006
         BNE   SJCCER                                                   10521007
         MVC   SJBCK1(2),SJBUCK+2            INIT FOR CONVERSION ROUT   10521008
         BAL   SJLKRG,SJCVHB                 CONVERT HEX TO BINARY      10521009
* RESULT IS IN SJW2RG.THIS WILL BE THE COUNT REG IN SKIP TAPE ROUTINE   10521010
SJSKTP   SVC   0                             SKIP TAPE TO A TAPE MARK   10521011
         DC    YL2(SJTCCB)                                              10521012
         TM    SJTCCB+2,X'80'                                           10521013
         BC    8,*-4                                                    10521014
         BCT   SJW1RG,SJSKTP                 LOOP TILL COUNT OF ZERO    10521015
         B     SJREAD                        EXIT                       10521016
SJREST   BALR  SJLKRG,SJSBRG                                            10521017
         BALR  SJLKRG,SJFBRG                 GET FIRST PARAM            10521018
         BAL   SJBRRG,SJSYSR+2               CONV SYSXXX TO A DISP      10521019
SJRS1    STH   SJW4RG,12(SJCRRG)             STORE DISP IN 2 USER BYTES 10521020
         BALR  SJLKRG,SJFBRG                 GET CHECKPOINT IDENTIFIER  10521021
         CLI   SJBUCK+4,C' '                                            10521022
         BNE   SJCCER                                                   10521023
         MVC  14(4,SJCRRG),SJBUCK            STORE IDEN IN USER BYTES   10521024
         OI    SJCRJB(SJCRRG),X'08'          SET RESTART FLAG ON        10521025
         B     SJREAD                                                   10521026
SJECCB   DC    X'002080000014'          EOJ CCB                         10521027
         DC    YL2(SJECCW)                                              10521028
SJECCW   CCW   9,SJEOJM,X'20',12                                        10521029
SJTCCB   DC    X'000010000018'         TAPE CCB                         10521030
         DC    YL2(SJTCCW)                                              10521031
SJTCCW   CCW   X'3F',SJINPT,X'20',1                                     10521032
SJDCCB   DC    X'001180000014'                                          10521033
         DC    YL2(SJDCCW)                                              10521034
SJDCCW   CCW   9,SJINPT,X'20',80                                        10521035
SJCCB    DC    X'000080000004'                                          10521036
         DC    YL2(SJCCW)                                               10521037
SJCCW    CCW   2,SJINPT,X'20',80                                        10521038
SJBCK1   DS    1CL8                                                     10521039
         DS    1CL80                                                    10521040
SJINPT   DS    1CL80                                                    10521041
SJEOB    DC    YL2(SJBUCK+9)            END OF BUCKET ADDRESS           10521042
SJEOC    DC    YL2(SJINPT+70)           END OF CARD ADDRESS             10521043
SJKW3    DC    X'00000003'                                              10521044
SJK008   DC    X'0008'                                                  10521045
SJK01    DC    X'0001'                                                  10521046
SJBUCK   DS    1CL9                                                     10521047
SJKCTL   DC    C'// '                                                   10521048
SJKPAU   DC    C'PAUSE'                                                 10521049
SJKJOB   DC    C'JOB '                                                  10521050
SJDAT    DC    C' '                                                     10521051
SJKSYS   DC    C'SYS'                                                   10521052
SJKRDR   DC    C'RDR'                                                   10521053
SJKLST   DC    C'LST'                                                   10521054
SJKIPT   DC    C'IPT'                                                   10521055
SJKOPT   DC    C'OPT'                                                   10521056
SJKLOG   DC    C'LOG '                                                  10521057
SJKNLG   DC    C'NOLOG'                                                 10521058
SJPUB    DC    C'    '                  TEMP PUB ENTRY                  10521059
SJ9BLK   DC    C'         '            9 BLANKS                         10521060
SJNJCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10521061
         DC    C'40'                       FOR NO JOB CARD              10521062
SJNDCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10521063
         DC    C'50'                       FOR NO DATE CARD             10521064
SJMSG1   DC    C'110'                   MESSAGE FOR DUP JOB CARDS       10521065
SJMSG2   DC    C'220'                   CONTROL CARD ERROR MESS175      10521066
SJMSG3   DC    C'200'                  ERROR MESSAGE FOR NO //          10521067
SJPMSG   DC    C'703A '                      PAUSE MESSAGE              10521068
SJDTAB   DC    X'02'                    DEVICE TABLE ENTRIES            10521069
         DC    C'C1'                                                    10521070
         DC    X'06'                                                    10521071
         DC    C'L1'                                                    10521072
         DC    X'12'                                                    10521073
         DC    C'L2'                                                    10521074
         DC    X'0A'                                                    10521075
         DC    C'P1'                                                    10521076
         DC    X'04'                                                    10521077
         DC    C'P2'                                                    10521078
         DC    X'10'                                                    10521079
         DC    C'R0'                                                    10521080
         DC    X'08'                                                    10521081
         DC    C'R1'                                                    10521082
         DC    X'0A'                                                    10521083
         DC    C'R2'                                                    10521084
         DC    X'04'                                                    10521085
         DC    C'R3'                                                    10521086
         DC    X'0E'                                                    10521087
         DC    C'S1'                                                    10521088
         DC    X'00'                                                    10521089
         DC    C'T1'                                                    10521090
         DC    X'00'                                                    10521091
         DC    C'T2'                                                    10521092
SJMOTB   DC    X'1F'                    DAYS IN MONTH TABLE             10521093
SJFEB    DC    X'1C'                                                    10521094
         DC    X'1F'                                                    10521095
         DC    X'1E'                                                    10521096
         DC    X'1F'                                                    10521097
         DC    X'1E'                                                    10521098
         DC    X'1F'                                                    10521099
         DC    X'1F'                                                    10521100
         DC    X'1E'                                                    10521101
         DC    X'1F'                                                    10521102
         DC    X'1E'                                                    10521103
         DC    X'1F'                                                    10521104
SJTABL   DC    YL2(SJDATE)              CONTROL CARD TABLE              10521105
SJKDAT   DC    C'DATE '                                                 10521106
         DC    YL2(SJCONF)                                              10521107
         DC    C'CONFG'                                                 10521108
         DC    YL2(SJVOL)                                               10521109
         DC    C'VOL  '                                                 10521110
         DC    YL2(SJFILE)                                              10521111
         DC    C'FILES'                                                 10521112
         DC    YL2(SJREST)                                              10521113
         DC    C'RSTRT'                                                 10521114
         DC    YL2(SJEXEC)                                              10521115
         DC    C'EXEC '                                                 10521116
         DC    YL2(SJUPSI)                                              10521117
         DC    C'UPSI '                                                 10521118
         DC    YL2(SJASGN)                                              10521119
SJKASG   DC    C'ASSGN'                                                 10521120
SJNUMT   DC    10X'00'                                                  10521121
         DC    C'123456'                                                10521122
SJK5F0   DC    X'F0F0F0F0F0'                                            10521123
SJK50F   DC    X'0F0F0F0F0F'                                            10521124
SJK12    DC    X'F1F2'                                                  10521125
SJKUA    DC    C'UA '                                                   10521126
SJKHEX   DC    CL2'X'''                 CONSTANT X'                     10521127
SJKQB    DC    CL2''' '                 CONSTANT QUOTE-BLANK            10521128
SJKRPG   DC    C'RPG100'                                                10521129
SJKASM   DC    C'ASSEMB'                                                10521130
SJKRES   DC    C'SYSRES'                                                10521131
SJEOJM   DC    C'N EOJ 123456'                                          10521132
*                                                                       10521133
* VOL CARD PROCESSING                                                   10521134
*                                                                       10521135
SJVOL    BALR  SJLKRG,SJSBRG    SKIP BLANKS                             10521136
         BAL   SJW3RG,SJSYSC            CONVERT AND TEST SYSXXX         10521137
         BALR  SJLKRG,SJFBRG            PUT FILE NAME IN BUCKET         10521138
         CLC   SJBUCK(7),SJ9BLK        TEST BLANK FILD                  10521139
         BE    SJLER1                                                   10521140
         MVC   SJLAB(7),SJBUCK         STORE FILE NAME IN LABEL W/A     10521141
         OI    SJNOBR+1,X'F0'                                           10521142
         B     SJREAD                                                   10521143
*       TPLAB CARD INITIAL PROCESSING                                   10521144
SJVOL1   MVI   SJLAB+7,X'00'                                            10521145
         MVC   SJLAB+8(75),SJLAB+7                                      10521146
         LA    SJW3RG,SJLAB+7                                           10521147
         OI    SJLAB3+1,X'F0'                                           10521148
         CLC   SJBUCK(5),SJTLAB         TEST FOR TPLAB CD               10521149
         BC    7,SJNOLC                 BRANCH NOT EQUAL                10521150
*                                                                       10521151
* TPLAB CARD PROCESSING                                                 10521152
*                                                                       10521153
SJTLBP   NI    SJNOBR+1,X'0F'      RESRT SJNOBR SWITCH                  10521154
         BAL   SJBRRG,SJSTRG      PROCESS STRING                        10521155
         B     SJTINU                   BRANCH POINTER FOR CONTINU CARD 10521156
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10521157
SJGOMO   EX    SJW2RG,SJMOV             MOVE LABEL INFOR                10521158
* CHECK -- STRING AT LEAST 49 BYTES                                     10521159
         LA    SJW3RG,0(SJW2RG,SJW3RG)  FIND LENGTH OF STRING           10521160
SJLNCK   CH    SJW3RG,SJTMIN            TEST LENGTH OF STRING           10521161
         BC    4,SJLCER                 BRANCH NEGATINE                 10521162
         BAL   SJBRRG,SJOTD             OUTPUT LABEL REC TO DISK        10521163
         B     SJREAD                   READ NEXT CARD                  10521164
*                                                                       10521165
SJMOV    MVC   0(1,SJW3RG),0(SJW4RG)    MOVE LABEL INFOR TO OUTPUT AREA 10521166
*                                                                       10521167
SJTINU   EX    SJW2RG,SJMOV                                             10521168
         LA    SJW3RG,1(SJW2RG,SJW3RG)  INCR LABEL OUTPUT AREA FILL ADR 10521169
         BAL   SJBRRG,SJRDCN            READ CONTINUATION CARD          10521170
         BAL   SJBRRG,SJSGAG            CONTINU STRING PROCESSING       10521171
         B     SJLCER                   2ND CONTINU IS ERROR            10521172
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10521173
         LA    SJBRRG,1(SJW2RG,SJW3RG)  FORM HI LAB ADDR REQUIRED       10521174
         CH    SJBRRG,SJLBHI            TEST FOR ERRONEOUSLY LONG LABEL 10521175
         BC    4,SJGOMO                 BRANCH LABEL                    10521176
         B     SJLCER                   BRANCH TO ERROR                 10521177
         USING SJLAB2,SJW3RG                                            10521178
SJOTD    LH    SJW3RG,SJLCTR+2                                          10521179
         MVC   SJLAB2(83),SJLAB                                         10521180
         LA    SJW3RG,83(SJW3RG)                                        10521181
         STH   SJW3RG,SJLCTR+2                                          10521182
         DROP  SJW3RG                                                   10521183
         BR    SJBRRG                                                   10521184
SJLCTR   DC    H'0'                                                     10521185
         DC    YL2(SJLAB2)                                              10521186
SJLBKT   DC    X'E000'                                                  10521187
SJKON8   DC    H'8192'                                                  10521188
* STRING PROCESSING ROUTINE                                             10521189
*                                                                       10521190
SJSTRG   OI    SJ2QSW+1,X'F0'           MAKE SURE SWITCH RESET          10521191
         BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10521192
         MVC   SJBUCK(9),SJ9BLK         BLANK SJBUCK                    10521193
         AH    0,SJK01                                                  10521194
         CLI   1(SJCCRG),X'7D'          TEST FOR ' AT START             10521195
         BC    7,SJLCER                 BRANCH NO '                     10521196
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10521197
         LA    SJW4RG,1(SJCCRG)         SAVE START ADDR                 10521198
SJGOON   LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10521199
         CH    SJCCRG,SJEOC             TEST FOR END OF CARD            10521200
         BC    10,SJEOCF                BRANCH NOT NEG                  10521201
         CLI   0(SJCCRG),X'7D'          TEST FOR '                      10521202
         BC    7,SJGOON                 BRANCH NOT EQUAL                10521203
SJQUOT   CLI   1(SJCCRG),X'7D'          TEST FOR 2ND '                  10521204
         BC    7,SJDID                  BRANCH NOT EQUAL                10521205
         LR    SJW2RG,SJCCRG            MOVE CARD COL INDEX             10521206
SJMVUP   BCTR  SJW2RG,0                 DECR TEMPORARY INDEX            10521207
         MVC   1(1,SJW2RG),0(SJW2RG)    MOVE 1 CHAR UP                  10521208
         CLR   SJW4RG,SJW2RG            TEST FOR LAST CHAR              10521209
         BC    10,SJMVUP                BRANCH NOT NEG                  10521210
         LA    SJW4RG,1(SJW4RG)         INCR BEGIN ADDR                 10521211
         LA    SJCCRG,2(SJCCRG)         INCR CARD COL INDEX             10521212
         B     SJGOON                   CONTINUE SCAN                   10521213
*                                                                       10521214
SJDID    LA    SJBRRG,4(SJBRRG)         INCR RETURN PAST USER EOC BRNCH 10521215
SJNDID   LR    SJW2RG,SJCCRG            FIND LENGTH-1 OF STRING         10521216
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10521217
         SR    SJW2RG,SJW4RG                                            10521218
         BCR   13,SJBRRG                RETURN IF LENGTH LENGTH 0       10521219
         BCTR  SJW2RG,0                                                 10521220
         BR    SJBRRG                   RETURN                          10521221
* CONTINUE SCAN ON CONTINUATION CARD                                    10521222
SJSGAG   LA    SJW4RG,1(SJCCRG)         SAVE STRING RESTART ADDR        10521223
SJ2QSW   BC    15,SJGOON                SWITCH TO NORMAL CONTINUATION   10521224
         OI    SJ2QSW+1,X'F0'           RESET SWITCH                    10521225
         B     SJQUOT                   GO TO 2ND QUOT TEST             10521226
*                                                                       10521227
SJEOCF   CLI   0(SJCCRG),X'7D'          END OF CARD OPERATIONS          10521228
         BC    7,SJNAPS                                                 10521229
         CLI   1(SJCCRG),C' '                                           10521230
         BC    8,SJDID                                                  10521231
         NI    SJ2QSW+1,X'0F'                                           10521232
         B     SJNDID                                                   10521233
*                                                                       10521234
SJNAPS   CLI   1(SJCCRG),C' '           TEST FOR CONTINUE               10521235
         BC    8,SJLCER                 BRANCH EQUAL                    10521236
SJNDEC   LR    SJW2RG,SJCCRG            FIND LENGTH-1 SO FAR            10521237
         SR    SJW2RG,SJW4RG                                            10521238
         BR    SJBRRG                                                   10521239
*                                                                       10521240
*                                                                       10521241
* READ CONTINUE CARD AND CHECK 1ST 15 COLS ARE BANK                     10521242
*                                                                       10521243
SJRDCN   BAL   SJLKRG,SJRDCD            READ CARD                       10521244
         CLI   SJINPT,C' '              TEST 1ST 15 COLS BLANK          10521245
         BNE   SJLCER                                                   10521246
         CLC   SJINPT+1(14),SJINPT                                      10521247
         BNE   SJLCER                                                   10521248
         LA    SJCCRG,SJINPT+14         LOAD CONTINUE SCAN ADDR         10521249
         BR    SJBRRG                   RETURN                          10521250
*                                                                       10521251
* SUBROUTINE -- RESET BRANCH SWITCHES                                   10521252
*                                                                       10521253
SJRRST   NI    SJNOBR+1,X'0F'        RESET NOBR SWITCHES                10521254
         BR    SJLKRG                                                   10521255
*                                                                       10521256
* NO LABEL CARD ROUTINE                                                 10521257
SJNOLC   BAL   SJLKRG,SJRRST                                            10521258
SJNLC1   NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL SWITCHES      10521259
         B     SJNOCC+8                 BRANCH TO NO CONTROL CARD       10521260
*ROUTINE FOR ERROR IN LABEL CARD                                        10521261
SJLCER   BAL   SJLKRG,SJRRST                                            10521262
SJLER1   NC    SJCRJB(2,SJCRRG),SJCRRS                                  10521263
         B     SJCCER                                                   10521264
* SUBROUTINE FOR SYSXXX CHECK AND CONVERSION                            10521265
SJSYSC   NI    SJNOBR+1,X'0F'   RESET SWITCHES                          10521266
         MVC   SJSAVS(2),SJCRJB(SJCRRG) SAVE JOB CONTROL BYTES          10521267
         NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL BYTES         10521268
         BALR  SJLKRG,SJSBRG   SKIP BLANKS                              10521269
         BAL   SJBRRG,SJSYSR   CONVERT AND CHECK                        10521270
         OI    SJNOBR+1,X'F0'     RESTORE SWITCHES                      10521271
         MVC   SJCRJB(2,SJCRRG),SJSAVS  RESTORE JOB CONTROL BYTES       10521272
         BR    SJW3RG    RETURN                                         10521273
SJMLAB   SR    SJW2RG,SJW2RG                                            10521274
         LA    SJW1RG,SJLAB2    GET WORK AREA ADD                       10521275
         LH    SJW4RG,SJLCTR+2                                          10521276
         SR    SJW4RG,SJW1RG                                            10521277
         SR    SJW3RG,SJW4RG   GET START ADD                            10521278
         MVI   0(SJW3RG),C'*'  PUT * IN FIRST POS VOL AREA              10521279
         LA    SJW3RG,1(SJW3RG)                                         10521280
SJLAB4   MVC   0(83,SJW3RG),0(SJW1RG)                                   10521281
         LA    SJW2RG,83(SJW2RG)                                        10521282
         LA    SJW1RG,83(SJW1RG)                                        10521283
         CR    SJW2RG,SJW4RG                                            10521284
         BE    SJEXQ6                                                   10521285
         LA    SJW3RG,83(SJW3RG)                                        10521286
         B     SJLAB4                                                   10521287
*  STORAGE AND CONSTANTS                                                10521288
SJLAB    DS    CL85                                                     10521289
SJTLAB   DC    CL5'TPLAB'                                               10521290
SJDECM   EQU   SJBCK1                                                   10521291
SJSAVS   DS    CL2                                                      10521292
SJTMIN   DC    YL2(SJLAB+55)                                            10521293
SJLBHI   DC    YL2(SJLAB+83)                                            10521294
SJCRRS   DC    X'8001'                                                  10521295
SJLAB2   DS    CL85                                                     10521296
         END   START                                                    10521297
         TITLE 'PHASE 1   TAPE TO PRINTER'                              10521298
         START 2488                                                     10521299
STRT     BALR  15,0                                                     10521300
         USING *,15                                                     10521301
         BC    15,INPUT                                                 10521302
         ORG   *+6                                                      10521303
SORS     DC    F'1'           STARTING RECORD NUMBER                    10521304
QORS     DC    F'0'           SEQUENCING INFORMATION                    10521305
IRCLN    DC    H'1000'        INPUT RECORD LENGTH                       10521306
IBKSZ    DC    H'1000'        INPUT BLOCK SIZE                          10521307
ORCLN    DC    H'120'         OUTPUT RECORD LENGTH                      10521308
OBKSZ    DC    H'120'         OUTPUT BLOCK SIZE                         10521309
TPGM     DC    X'28'          PROGRAM TYPE                              10521310
TJOB     DC    X'10'          TYPE OF JOB                               10521311
FRCD     DC    X'04'          RECORD FORMAT                             10521312
DOPTN    DC    X'84'          INPUT AND OUTPUT OPTIONS                  10521313
POPTN    DC    X'11'          PAGING AND SPACING INFORMATION            10521314
LABSW    DC    X'00'                                                    10521315
ICU      DC    X'00'                                                    10521316
OCU      DC    X'00'                                                    10521317
IBKC     DC    F'0'                                                     10521318
OBKC     DC    F'0'                                                     10521319
LABIH    DC    C'**'                                                    10521320
LABOH    DC    C'**'                                                    10521321
LABIT    DC    X'1836'        INITIALIZED TO INPUT HEADER END           10521322
LABOT    DC    H'0'                                                     10521323
LABOR    DC    H'0'                                                     10521324
AAST     DC    H'0'                                                     10521325
LABRTN   DC    X'1506'        INITIALIZED TO END OF PHASE 4             10521326
IPA      DC    X'0C0C'                                                  10521327
OPA      DC    X'1010'                                                  10521328
INA      DC    X'16CC'        INITIALIZED TO INPUT TRAILER END          10521329
INB      DC    H'0'                                                     10521330
OUTA     DC    H'0'                                                     10521331
OUTB     DC    H'0'                                                     10521332
UCLIM    DC    H'0'                                                     10521333
SWHD     DC    X'00'                                                    10521334
NOIO     DC    X'00'                                                    10521335
HEAD     DC    CL16'                '                                   10521336
         DC    CL16'                '                                   10521337
         DC    CL16'                '                                   10521338
         DC    CL16'                '                                   10521339
         DC    CL16'                '                                   10521340
         DC    CL16'                '                                   10521341
         DC    CL16'                '                                   10521342
         DC    CL16'                '                                   10521343
         DC    CL16'                '                                   10521344
DSTBL    DC    C'0123456789ABCDEF'                                      10521345
ULAB1    DC    H'0'                                                     10521346
ULAB2    DC    H'0'                                                     10521347
ULAB3    DC    H'0'                                                     10521348
ULAB4    DC    H'0'                                                     10521349
URET     DC    H'0'                                                     10521350
ULAB     DC    H'0'                                                     10521351
USW      DC    X'F0'                                                    10521352
         ORG   SORS+250                                                 10521353
*                                                                       10521354
***   CONTROL CARD INPUT                                                10521355
*                                                                       10521356
INPUT    SVC   0                                                        10521357
         DC    YL2(CCB)                                                 10521358
         TM    CCB+2,X'80'                                              10521359
         BC    8,*-4                                                    10521360
         CLC   HD1(3),CRDAR   IS CONTROL CARD                           10521361
         BC    7,LG1          NO                                        10521362
         CLI   CRDAR+3,C'U'   IS UTILITY MODIFIER CARD                  10521363
         BC    8,UTMF         YES                                       10521364
         CLC   HD2(3),CRDAR+3 IS FIELD SELECT CARD                      10521365
         BC    8,FS           YES                                       10521366
         TM    FSW,X'0F'      IS FIELD SELECT ENFORCED                  10521367
         BC    7,LG3          YES, LOG MESSAGE                          10521368
         CLC   HD3(3),CRDAR+3 IS HEADER CARD NO.1                       10521369
         BC    7,*+12         NO                                        10521370
         OI    SWHD,X'FF'     YES, SET SWHD                             10521371
         BC    15,HD                                                    10521372
         CLC   HD4(3),CRDAR+3 IS HEADER CARD NO.2                       10521373
         BC    7,*+12         NO                                        10521374
         OI    SWHD,X'FF'     YES, SET SWHD                             10521375
         BC    15,HDSD                                                  10521376
         CLC   HD5(3),CRDAR+3 IS END CARD                               10521377
         BC    7,LG6                                                    10521378
LGSW     BC    0,EOJ                                                    10521379
         SVC   1                                                        10521380
         DC    C'SYSLOD'                                                10521381
*                                                                       10521382
***   CONVERSION ROUTINE                                                10521383
*                                                                       10521384
BIN      MVC   BINC+1(1),0(6) SUPPLY ENDING CHARACTER                   10521385
         MVC   CBNN+1(1),0(6)                                           10521386
         LR    3,2            CHECK 4 DIGITS                            10521387
         LA    4,1                                                      10521388
         LA    5,3(2)                                                   10521389
         MVI   *-1,X'03'                                                10521390
LOOP     CLI   0(3),X'F0'                                               10521391
         BCR   4,8                                                      10521392
         CLI   0(3),X'F9'                                               10521393
         BCR   2,8                                                      10521394
         BXH   3,4,CBNN                                                 10521395
BINC     CLI   0(3),C','                                                10521396
         BC    8,*+14                                                   10521397
         BC    15,LOOP                                                  10521398
CBNN     CLI   0(3),C','                                                10521399
         BCR   7,8                                                      10521400
         LR    4,2                                                      10521401
         LA    2,1(3)                                                   10521402
         SR    3,4                                                      10521403
         BCTR  3,0                                                      10521404
         AH    3,N112                                                   10521405
         STC   3,*+5                                                    10521406
         PACK  TEMP(8),0(0,4) CONVERT TO BINARY                         10521407
         CVB   3,TEMP                                                   10521408
         C     3,N64K                                                   10521409
         BC    2,*+12                                                   10521410
         STH   3,0(9)                                                   10521411
         BC    15,2(6)                                                  10521412
         BCTR  2,0                                                      10521413
         BCR   15,8                                                     10521414
*                                                                       10521415
***   ERROR LOGGING ROUTINE                                             10521416
*                                                                       10521417
LG1      LA    5,MSSG1                                                  10521418
         LA    6,15                                                     10521419
         STC   6,LGMVC+1                                                10521420
         BC    15,LG                                                    10521421
LG2      LA    5,MSSG2                                                  10521422
         LA    6,38                                                     10521423
         STC   6,LGMVC+1                                                10521424
         OI    NTSW+1,X'F0'                                             10521425
         BC    15,LG                                                    10521426
LG3      LA    5,MSSG3                                                  10521427
         LA    6,24                                                     10521428
         STC   6,LGMVC+1                                                10521429
         BC    15,LG                                                    10521430
LG4      LA    5,MSSG4                                                  10521431
         LA    6,36                                                     10521432
         STC   6,LGMVC+1                                                10521433
         OI    NTSW+1,X'F0'                                             10521434
         LH    3,NOFS                                                   10521435
         AH    3,N1                                                     10521436
         STH   3,NOFS                                                   10521437
         BC    15,LG                                                    10521438
LG5      LA    5,MSSG5                                                  10521439
         LA    6,29                                                     10521440
         STC   6,LGMVC+1                                                10521441
         BC    15,LG                                                    10521442
LG6      LA    5,MSSG6                                                  10521443
         LA    6,19                                                     10521444
         STC   6,LGMVC+1                                                10521445
LG       XC    LOGAR(39),LOGAR    CLEAR PRINT AREA                      10521446
         LA    6,1(6)                                                   10521447
         STC   6,CCWL+7                                                 10521448
LGMVC    MVC   LOGAR(0),0(5)  MOVE MESSAGE TO PRINT AREA                10521449
         SVC   0             PRINT MSSG                                 10521450
         DC    YL2(CCBL)                                                10521451
         TM    CCBL+2,X'80'                                             10521452
         BC    8,*-4                                                    10521453
         OI    LGSW+1,X'F0'                                             10521454
NTSW     BC    0,NTRTN                                                  10521455
EOJ      SVC   1                                                        10521456
         DC    C'SYSEOJ'                                                10521457
NTRTN    NI    NTSW+1,X'00'                                             10521458
CKSW     BC    0,TPJOB                                                  10521459
CKSW1    BC    0,TPJBS                                                  10521460
         CLI   FSW,X'F0'                                                10521461
         BC    8,FSCK                                                   10521462
RET      LA    2,1(2)                                                   10521463
         CLI   0(2),C','                                                10521464
         BC    7,*+12                                                   10521465
         LA    2,1(2)                                                   10521466
         BC    15,SFSC+12                                               10521467
         CLI   0(2),C' '                                                10521468
         BC    7,RET                                                    10521469
         BC    15,SFS+8                                                 10521470
FSCK     LA    2,1(2)                                                   10521471
         CLI   0(2),C'/'                                                10521472
         BC    7,*+12                                                   10521473
         LA    2,1(2)                                                   10521474
         BC    15,FSIN                                                  10521475
         CLI   0(2),C' '                                                10521476
         BC    7,FSCK                                                   10521477
         BC    15,INPUT                                                 10521478
*                                                                       10521479
***   FINDING TYPE OF PROGRAM                                           10521480
*                                                                       10521481
UTMF     LA    2,CRDAR+4                                                10521482
         CLI   0(2),C' '      IS NEXT BLANK                             10521483
         BC    8,TPJBS        YES, BRANCH TO TPJBS                      10521484
         MVI   MSSG2,C'N'                                               10521485
         OI    CKSW+1,X'F0'                                             10521486
         CLI   0(2),C'C'      IS CARD INPUT                             10521487
         BC    7,*+12         NO, BRANCH TO NEXT                        10521488
         MVI   TPGM,X'10'     YES, SET TPGM                             10521489
         BC    15,OUTD                                                  10521490
         CLI   0(2),C'T'      IS TAPE INPUT                             10521491
         BC    7,*+12         NO, BRANCH TO NEXT                        10521492
         MVI   TPGM,X'20'     YES, SET TPGM                             10521493
         BC    15,OUTD                                                  10521494
         CLI   0(2),C'D'      IS DISK INPUT                             10521495
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10521496
         MVI   TPGM,X'40'     YES, SET TPGM                             10521497
OUTD     CLI   1(2),C'C'      IS CARD OUTPUT                            10521498
         BC    7,*+12         NO, BRANCH TO NEXT                        10521499
         OI    TPGM,X'01'     YES, SET TPGM                             10521500
         BC    15,TPJOB                                                 10521501
         CLI   1(2),C'T'      IS TAPE OUTPUT                            10521502
         BC    7,*+12         NO, BRANCH TO NEXT                        10521503
         OI    TPGM,X'02'     YES, SET TPGM                             10521504
         BC    15,TPJOB                                                 10521505
         CLI   1(2),C'D'      IS DISK OUTPUT                            10521506
         BC    7,*+12         NO, BRANCH TO NEXT                        10521507
         OI    TPGM,X'04'     YES, SET TPGM                             10521508
         BC    15,TPJOB                                                 10521509
         CLI   1(2),C'P'      IS PRINT OUTPUT                           10521510
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10521511
         OI    TPGM,X'08'     YES, SET TPGM                             10521512
*                                                                       10521513
***   FINDING TYPE OF JOB                                               10521514
*                                                                       10521515
TPJOB    NI    CKSW+1,X'00'                                             10521516
         OI    CKSW1+1,X'F0'                                            10521517
         LA    2,2(2)                                                   10521518
         CLI   0(2),C' '      IS NEXT BLANK                             10521519
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521520
TPJBS    NI    CKSW1+1,X'00'                                            10521521
         MVI   MSSG2,C'T'                                               10521522
         CLI   1(2),C'T'      IS TYPE DEFINED                           10521523
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521524
         MVI   MSSG2,C'J'                                               10521525
         LA    2,2(2)                                                   10521526
         CLI   0(2),C'C'      IS COPY                                   10521527
         BC    7,*+12         NO, BRANCH TO NEXT                        10521528
         MVI   TJOB,X'01'     YES, SET TJOB                             10521529
         BC    15,SFSC                                                  10521530
         CLI   0(2),C'F'      IS FIELD SELECT                           10521531
         BC    7,*+16         NO, BRANCH TO NEXT                        10521532
         MVI   TJOB,X'02'     YES, SET TJOB                             10521533
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10521534
         BC    15,SFSC                                                  10521535
         CLI   0(2),C'R'      IS REBLOCK                                10521536
         BC    7,EDD          NO, BRANCH TO NEXT                        10521537
         CLI   1(2),C'F'      IS REBLOCK AND FIELD SELECT               10521538
         BC    7,*+20         NO                                        10521539
         MVI   TJOB,X'08'     YES, SET TJOB                             10521540
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10521541
         LA    2,1(2)                                                   10521542
         BC    15,SFSC                                                  10521543
         MVI   TJOB,X'04'     SET TJOB                                  10521544
         BC    15,SFSC                                                  10521545
EDD      CLI   0(2),C'D'      IS DATA DISPLAY                           10521546
         BC    7,*+12         NO, BRANCH TO NEXT                        10521547
         MVI   TJOB,X'10'     YES, SET TJOB                             10521548
         BC    15,SFSC                                                  10521549
         CLI   0(2),C'L'      IS LIST                                   10521550
         BC    7,EB           NO, BRANCH TO EB                          10521551
         CLI   1(2),C'F'      IS LIST AND FIELD SELECT                  10521552
         BC    7,*+20         NO                                        10521553
         MVI   TJOB,X'00'     YES, SET TJOB                             10521554
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10521555
         LA    2,1(2)                                                   10521556
         BC    15,SFSC                                                  10521557
         MVI   TJOB,X'20'     SET TJOB                                  10521558
         BC    15,SFSC                                                  10521559
EB       CLI   0(2),C'B'      IS BOTH                                   10521560
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521561
         CLI   1(2),C'F'      IS BOTH WITH FIELD SELECT                 10521562
         BC    7,*+20         NO                                        10521563
         MVI   TJOB,X'80'     YES, SET TJOB                             10521564
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10521565
         LA    2,1(2)                                                   10521566
         BC    15,SFSC                                                  10521567
         MVI   TJOB,X'40'     SET TJOB                                  10521568
         BC    15,SFSC                                                  10521569
*                                                                       10521570
***   ENTRANCE TO SEARCH OF PARAMETERS                                  10521571
*                                                                       10521572
SFS      CLI   1(2),C' '      IS BLANK                                  10521573
         BC    7,SFSC         NO, BRANCH TO SFSC                        10521574
         BC    0,INPUT                                                  10521575
         OI    *-3,X'F0'                                                10521576
         MVI   MSSG2,C'M'                                               10521577
         CLI   REQPA,X'07'    GOT ALL REQUIRED PARAMETERS               10521578
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521579
         BC    15,INPUT       YES, READ NEXT CARD                       10521580
SFSC     CLI   1(2),C','      IS COMMA                                  10521581
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521582
         LA    2,2(2)                                                   10521583
*                                                                       10521584
***   RECORD FORMAT PARAMETER                                           10521585
*                                                                       10521586
         CLI   0(2),C'F'      IS FORMAT DEFINED                         10521587
         BC    7,INF          NO, BRANCH TO INF                         10521588
         NI    FRCD,X'F0'                                               10521589
         LA    2,1(2)                                                   10521590
         OI    REQPA,X'01'    YES, MODIFY REQPA                         10521591
         MVI   MSSG2,C'F'                                               10521592
         CLI   0(2),C'F'      IS F-PARAMETER                            10521593
         BC    7,*+12         NO, BRANCH TO NEXT                        10521594
         OI    FRCD,X'01'     YES, MODIFY FRCD                          10521595
         BC    15,SFS                                                   10521596
         CLI   0(2),C'V'      IS V-PARAMETER                            10521597
         BC    7,*+12         NO, BRANCH TO NEXT                        10521598
         OI    FRCD,X'02'     YES, MODIFY FRCD                          10521599
         BC    15,SFS                                                   10521600
         CLI   0(2),C'U'      IS U-PARAMETER                            10521601
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521602
         OI    FRCD,X'04'     YES, MODIFY FRCD                          10521603
         BC    15,SFS                                                   10521604
*                                                                       10521605
***   A-PARAMETER                                                       10521606
*                                                                       10521607
INF      CLC   0(3,2),HD6     IS A-PARAMETER                            10521608
         BC    7,OUTF         NO, BRANCH TO OUTF                        10521609
         OI    REQPA,X'02'    YES, MODIFY REQPA                         10521610
         MVI   MSSG2,C'A'                                               10521611
         LA    2,3(2)                                                   10521612
         TM    FRCD,X'01'     IS FIXED                                  10521613
         BC    8,LICB         NO, BRANCH TO LICB                        10521614
         CLC   0(2,2),HD7     IS 'K='                                   10521615
         BC    7,ULFT         NO, BRANCH TO ULFT                        10521616
         OI    FRCD,X'10'     YES, MODIFY FRCD                          10521617
         LA    2,2(2)                                                   10521618
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10521619
         LA    9,IRCLN        AND STORE IN IRCLN                        10521620
         BAL   6,BIN                                                    10521621
         DC    C', '                                                    10521622
         CLC   0(2,2),HD8     IS 'D='                                   10521623
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521624
         LA    2,2(2)                                                   10521625
         BC    15,LICB                                                  10521626
ULFT     LA    8,LG2          CONVERT DIGITS TO BINARY                  10521627
         LA    9,IRCLN        AND STORE IN IRCLN                        10521628
         BAL   6,BIN                                                    10521629
         DC    C', '                                                    10521630
LICB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10521631
         LA    9,IBKSZ        AND STORE IN IBKSZ                        10521632
         MVI   LOOP-5,X'04'                                             10521633
         BAL   6,BIN                                                    10521634
         DC    C') '                                                    10521635
         TM    FRCD,X'01'     IS FIXED                                  10521636
         BC    1,*+10         YES                                       10521637
         MVC   IRCLN(2),IBKSZ NO, DEFINE INPUT RECORD LENGTH            10521638
         BCTR  2,0                                                      10521639
         BC    15,SFS                                                   10521640
*                                                                       10521641
***   B-PARAMETER                                                       10521642
*                                                                       10521643
OUTF     CLC   0(3,2),HD9     IS B-PARAMETER                            10521644
         BC    7,IPAR         NO, BRANCH TO IPAR                        10521645
         OI    REQPA,X'04'    YES, MODIFY REQPA                         10521646
         MVI   MSSG2,C'B'                                               10521647
         LA    2,3(2)                                                   10521648
         TM    FRCD,X'01'     IS FIXED                                  10521649
         BC    8,LOCB         NO, BRANCH TO LOCB                        10521650
         CLC   0(2,2),HD7     IS 'K='                                   10521651
         BC    8,LCHS         YES, BRANCH TO LCHS                       10521652
         LR    3,2                                                      10521653
         LA    4,1                                                      10521654
         LA    5,3(2)                                                   10521655
LOOP1    CLI   0(3),X'F0'                                               10521656
         BC    4,LG2                                                    10521657
         CLI   0(3),X'F9'                                               10521658
         BC    2,LG2                                                    10521659
         BXH   3,4,CBNN1                                                10521660
         CLI   0(3),C','                                                10521661
         BC    8,CNQ1                                                   10521662
         CLI   0(3),C')'                                                10521663
         BC    7,LOOP1                                                  10521664
         OI    LABSW,X'01'                                              10521665
         BC    15,LOCB                                                  10521666
CBNN1    CLI   0(3),C','                                                10521667
         BC    8,CNQ1                                                   10521668
         CLI   0(3),C')'                                                10521669
         BC    7,LG2                                                    10521670
         OI    LABSW,X'01'                                              10521671
         BC    15,LOCB                                                  10521672
CNQ1     LR    5,2                                                      10521673
         LA    2,1(3)                                                   10521674
         BCTR  3,0                                                      10521675
         SR    3,5                                                      10521676
         AH    3,N112                                                   10521677
         STC   3,*+5                                                    10521678
         PACK  TEMP(8),0(0,5)                                           10521679
         CVB   3,TEMP                                                   10521680
         STH   3,ORCLN                                                  10521681
LOCB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10521682
         LA    9,OBKSZ        AND STORE IN OBKSZ                        10521683
         MVI   LOOP-5,X'04'                                             10521684
         BAL   6,BIN                                                    10521685
         DC    C') '                                                    10521686
         BCTR  2,0                                                      10521687
         TM    FRCD,X'01'                                               10521688
         BC    8,*+16                                                   10521689
         TM    LABSW,X'01'                                              10521690
         BC    1,SORL                                                   10521691
         BC    15,SFS                                                   10521692
SORL     MVC   ORCLN(2),OBKSZ YES, DEFINE OUTPUT RECORD LENGTH          10521693
         BC    15,SFS                                                   10521694
LCHS     OI    FRCD,X'20'     MODIFY FRCD                               10521695
         LA    2,2(2)                                                   10521696
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10521697
         LA    9,ORCLN        AND STORE IN ORCLN                        10521698
         BAL   6,BIN                                                    10521699
         DC    C', '                                                    10521700
         CLC   0(2,2),HD8     IS 'D='                                   10521701
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521702
         LA    2,2(2)                                                   10521703
         BC    15,LOCB                                                  10521704
*                                                                       10521705
***   I-PARAMETER                                                       10521706
*                                                                       10521707
IPAR     CLI   0(2),C'I'      IS I-PARAMETER                            10521708
         MVI   MSSG2,C'I'                                               10521709
         BC    7,OPAR         NO, BRANCH TO OPAR                        10521710
         NI    DOPTN,X'0F'                                              10521711
         CLI   1(2),C'1'      IS '1'                                    10521712
         BC    7,*+12         NO, BRANCH TO NEXT                        10521713
         OI    DOPTN,X'00'    YES, SET DOPTN                            10521714
         BC    15,TMIP                                                  10521715
         CLI   1(2),C'2'      IS '2'                                    10521716
         BC    8,*+12         YES                                       10521717
         CLI   1(2),C'M'      IS 'M'                                    10521718
         BC    7,*+12         NO, BRANCH TO NEXT                        10521719
         OI    DOPTN,X'10'    YES, SET DOPTN                            10521720
         BC    15,TMIP                                                  10521721
         CLI   1(2),C'U'      IS 'U'                                    10521722
         BC    7,*+12         NO, BRANCH TO NEXT                        10521723
         OI    DOPTN,X'80'    YES, SET DOPTN                            10521724
         BC    15,TMIP                                                  10521725
         CLI   1(2),C'R'      IS 'R'                                    10521726
         BC    7,*+12         NO, BRANCH TO NEXT                        10521727
         OI    DOPTN,X'40'    YES, SET DOPTN                            10521728
         BC    15,TMIP                                                  10521729
         CLI   1(2),C'N'      IS 'N'                                    10521730
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521731
         OI    DOPTN,X'20'    YES, SET DOPTN                            10521732
TMIP     LA    2,1(2)                                                   10521733
         BC    15,SFS                                                   10521734
*                                                                       10521735
***   O-PARAMETER                                                       10521736
*                                                                       10521737
OPAR     CLI   0(2),C'O'      IS O-PARAMETER                            10521738
         BC    7,SPAR         NO, BRANCH TO SPAR                        10521739
         MVI   MSSG2,C'O'                                               10521740
         NI    DOPTN,X'F0'                                              10521741
         CLI   1(2),C'1'      IS '1'                                    10521742
         BC    7,*+12         NO, BRANCH TO NEXT                        10521743
         OI    DOPTN,X'00'    YES, SET DOPTN                            10521744
         BC    15,TMOP                                                  10521745
         CLI   1(2),C'2'      IS '2'                                    10521746
         BC    8,*+12                                                   10521747
         CLI   1(2),C'Y'      NO, IS 'Y'                                10521748
         BC    7,*+12         NO, BRANCH TO NEXT                        10521749
         OI    DOPTN,X'01'    YES, SET DOPTN                            10521750
         BC    15,TMOP                                                  10521751
         CLI   1(2),C'U'      IS 'U'                                    10521752
         BC    8,*+12                                                   10521753
         CLI   1(2),C'C'      NO, IS 'C'                                10521754
         BC    7,*+12         NO, BRANCH TO NEXT                        10521755
         OI    DOPTN,X'08'    YES, SET DOPTN                            10521756
         BC    15,TMOP                                                  10521757
         CLI   1(2),C'R'      IS 'R'                                    10521758
         BC    8,*+12                                                   10521759
         CLI   1(2),C'X'      NO, IS 'X'                                10521760
         BC    7,*+12         NO, BRANCH TO NEXT                        10521761
         OI    DOPTN,X'04'    YES, SET DOPTN                            10521762
         BC    15,TMOP                                                  10521763
         CLI   1(2),C'N'      IS 'N'                                    10521764
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521765
         OI    DOPTN,X'02'    YES, SET DOPTN                            10521766
TMOP     LA    2,1(2)                                                   10521767
         BC    15,SFS                                                   10521768
*                                                                       10521769
***   S-PARAMETER                                                       10521770
*                                                                       10521771
SPAR     CLI   0(2),C'S'      IS S-PARAMETER                            10521772
         BC    7,PPAR         NO, BRANCH TO PPAR                        10521773
         MVI   MSSG2,C'S'                                               10521774
         NI    POPTN,X'0F'                                              10521775
         CLI   1(2),C'1'      IS '1'                                    10521776
         BC    7,*+12         NO, BRANCH TO NEXT                        10521777
         OI    POPTN,X'10'    YES, SET POPTN                            10521778
         BC    15,TMSP                                                  10521779
         CLI   1(2),C'2'      IS '2'                                    10521780
         BC    7,*+12         NO, BRANCH TO NEXT                        10521781
         OI    POPTN,X'20'    YES, SET POPTN                            10521782
         BC    15,TMSP                                                  10521783
         CLI   1(2),C'3'      IS '3'                                    10521784
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521785
         OI    POPTN,X'40'    YES, SET POPTN                            10521786
TMSP     LA    2,1(2)                                                   10521787
         BC    15,SFS                                                   10521788
*                                                                       10521789
***   P-PARAMETER                                                       10521790
*                                                                       10521791
PPAR     CLI   0(2),C'P'      IS P-PARAMETER                            10521792
         BC    7,RPAR         NO, BRANCH TO RPAR                        10521793
         MVI   MSSG2,C'P'                                               10521794
         NI    POPTN,X'F0'                                              10521795
         CLI   1(2),C'Y'      IS 'Y'                                    10521796
         BC    7,*+12         NO, BRANCH TO NEXT                        10521797
         OI    POPTN,X'01'    YES, SET POPTN                            10521798
         BC    15,TMPP                                                  10521799
         CLI   1(2),C'N'      IS 'N'                                    10521800
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521801
         OI    POPTN,X'02'    YES, SET POPTN                            10521802
TMPP     LA    2,1(2)                                                   10521803
         BC    15,SFS                                                   10521804
*                                                                       10521805
***   R-PARAMETER                                                       10521806
*                                                                       10521807
RPAR     CLI   0(2),C'R'     IS R-PARAMETER                             10521808
         BC    7,QPAR         NO, BRANCH TO QPAR                        10521809
         MVI   MSSG2,C'R'                                               10521810
         LA    2,1(2)         CHECK DIGITS                              10521811
         LR    3,2                                                      10521812
         LA    4,1                                                      10521813
         LA    5,7(2)                                                   10521814
LP1      CLI   0(3),X'F0'                                               10521815
         BC    4,LG2                                                    10521816
         CLI   0(3),X'F9'                                               10521817
         BC    2,LG2                                                    10521818
         BXH   3,4,CBIN1                                                10521819
         CLI   0(3),C','                                                10521820
         BC    8,CBIN1+16                                               10521821
         CLI   0(3),C' '                                                10521822
         BC    7,LP1                                                    10521823
         BC    8,CBIN1+16                                               10521824
CBIN1    CLI   0(3),C','                                                10521825
         BC    8,*+12                                                   10521826
         CLI   0(3),C' '                                                10521827
         BC    7,LG2                                                    10521828
         LR    5,2            CONVERT TO BINARY AND STORE IT TO SORS    10521829
         BCTR  3,0                                                      10521830
         LR    2,3                                                      10521831
         SR    3,5                                                      10521832
         AH    3,N112                                                   10521833
         STC   3,*+5                                                    10521834
         PACK  TEMP(8),0(0,5)                                           10521835
         CVB   3,TEMP                                                   10521836
         ST    3,SORS                                                   10521837
         BC    15,SFS                                                   10521838
*                                                                       10521839
***   Q-PARAMETER                                                       10521840
*                                                                       10521841
QPAR     CLC   0(3,2),HD11    IS Q-PARAMETER                            10521842
         MVI   MSSG2,C'U'                                               10521843
         BC    7,LG2          NO, ILLEGAL FORMAT                        10521844
         MVI   MSSG2,C'Q'                                               10521845
         LA    2,3(2)         CHECK DIGITS                              10521846
         LR    3,2                                                      10521847
         LA    4,1                                                      10521848
         LA    5,1(2)                                                   10521849
LP2      CLI   0(3),X'F0'                                               10521850
         BC    4,LG2                                                    10521851
         CLI   0(3),X'F9'                                               10521852
         BC    2,LG2                                                    10521853
         BXH   3,4,CBIN2                                                10521854
         CLI   0(3),C','                                                10521855
         BC    7,LP2                                                    10521856
         BC    8,*+12                                                   10521857
CBIN2    CLI   0(3),C','                                                10521858
         BC    7,LG2                                                    10521859
         LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS    10521860
         LR    2,3                                                      10521861
         BCTR  3,0                                                      10521862
         SR    3,5                                                      10521863
         AH    3,N112                                                   10521864
         STC   3,*+5                                                    10521865
         PACK  TEMP(8),0(0,5)                                           10521866
         CVB   3,TEMP                                                   10521867
         STH   3,QORS                                                   10521868
         LA    2,1(2)         CHECK DIGITS                              10521869
         LR    3,2                                                      10521870
         LA    4,1                                                      10521871
         LA    5,1(2)                                                   10521872
LP3      CLI   0(3),X'F0'                                               10521873
         BC    4,LG2                                                    10521874
         CLI   0(3),X'F9'                                               10521875
         BC    2,LG2                                                    10521876
         BXH   3,4,CBIN3                                                10521877
         CLI   0(3),C')'                                                10521878
         BC    8,CNQ                                                    10521879
         BC    7,LP3                                                    10521880
CBIN3    CLI   0(3),C')'                                                10521881
         BC    7,LG2                                                    10521882
CNQ      LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS+2  10521883
         LR    2,3                                                      10521884
         BCTR  3,0                                                      10521885
         SR    3,5                                                      10521886
         AH    3,N112                                                   10521887
         STC   3,*+5                                                    10521888
         PACK  TEMP(8),0(0,5)                                           10521889
         CVB   3,TEMP                                                   10521890
         STH   3,QORS+2                                                 10521891
         BC    15,SFS                                                   10521892
*                                                                       10521893
***   ENTRANCE TO FIELD SELECT CARD                                     10521894
*                                                                       10521895
FS       TM    FSW,X'F0'      IS FIELD SELECT POSSIBLE                  10521896
         BC    8,LG5          NO, UNNECESSARY CARD                      10521897
         LA    2,CRDAR+6                                                10521898
         BC    0,FSIN                                                   10521899
         OI    *-3,X'F0'                                                10521900
         MVI   FSW,X'F0'      CLEAR ENFORCED SWITCH                     10521901
         XC    NOFS(2),NOFS   SET NOFS ZERO                             10521902
         LA    7,NOFS+2       SET REGISTER 7                            10521903
*                                                                       10521904
***   FIELD SELECT CARD                                                 10521905
*                                                                       10521906
FSIN     LH    4,NOFS                                                   10521907
         AH    4,N1                                                     10521908
         CVD   4,TEMP                                                   10521909
         UNPK  MSSG4(3),TEMP+6(2)                                       10521910
         OI    MSSG4+2,X'F0'                                            10521911
         CLC   0(3,2),HD10    IS '(K,'                                  10521912
         BC    7,INKEY        NO, BRANCH TO INKEY                       10521913
         LA    2,3(2)         YES, SET BITS                             10521914
         MVI   0(7),X'80'                                               10521915
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10521916
         LA    9,4(7)         AND STORE IN R7+4                         10521917
         BAL   6,BIN                                                    10521918
         DC    C') '                                                    10521919
         CLI   0(2),C','      IS ','                                    10521920
         BC    7,LG4          NO, ILLEGAL FORMAT                        10521921
         LA    2,1(2)                                                   10521922
         BC    15,*+22        YES                                       10521923
INKEY    MVI   0(7),X'00'                                               10521924
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10521925
         LA    9,4(7)         AND STORE IN R7+4                         10521926
         BAL   6,BIN                                                    10521927
         DC    C', '                                                    10521928
         CLI   0(2),C'('      IS '('                                    10521929
         BC    8,FLDL         YES, BRANCH TO FLDL                       10521930
         NI    0(7),X'9F'     NO, SET BITS                              10521931
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10521932
         LA    9,10(7)        AND STORE IN R7+10                        10521933
         BAL   6,BIN                                                    10521934
         DC    C', '                                                    10521935
         XC    8(2,7),8(7)                                              10521936
         BC    15,FSOUT                                                 10521937
FLDL     CLI   1(2),C'P'      IS 'P'                                    10521938
         BC    7,UCOM         NO, BRANCH TO UCOM                        10521939
         OI    0(7),X'20'     YES, SET BIT                              10521940
         BC    15,PUCOM                                                 10521941
UCOM     CLI   1(2),C'U'      IS 'U'                                    10521942
         BC    7,XCOM         NO, BRANCH TO XCOM                        10521943
         OI    0(7),X'40'     YES, SET BIT                              10521944
PUCOM    CLI   2(2),C','      IS ','                                    10521945
         BC    7,LG4          NO, ILLEGAL FORMAT                        10521946
         LA    2,3(2)                                                   10521947
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10521948
         LA    9,8(7)         AND STORE IN R7+8                         10521949
         BAL   6,BIN                                                    10521950
         DC    C', '                                                    10521951
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10521952
         LA    9,10(7)        AND STORE IN R7+10                        10521953
         BAL   6,BIN                                                    10521954
         DC    C') '                                                    10521955
         BC    15,LFSP                                                  10521956
XCOM     CLI   1(2),C'X'      IS 'X'                                    10521957
         BC    7,LG4          NO, ILLEGAL FORMAT                        10521958
         OI    0(7),X'60'     YES, SET BIT                              10521959
         CLI   2(2),C','      IS ','                                    10521960
         BC    7,LG4          NO, ILLEGAL FORMAT                        10521961
         LA    2,3(2)                                                   10521962
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10521963
         LA    9,10(7)        AND STORE IN R7+10                        10521964
         BAL   6,BIN                                                    10521965
         DC    C') '                                                    10521966
         XC    8(2,7),8(7)                                              10521967
LFSP     CLI   0(2),C','      IS ','                                    10521968
         BC    7,LG4          NO, ILLEGAL FORMAT                        10521969
         LA    2,1(2)                                                   10521970
FSOUT    CLC   0(3,2),HD10    IS '(K,'                                  10521971
         BC    7,ONKEY        NO, BRANCH TO ONKEY                       10521972
         LA    2,3(2)                                                   10521973
         OI    0(7),X'10'     YES, SET BIT                              10521974
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10521975
         LA    9,6(7)         AND STORE IN R7+6                         10521976
         BAL   6,BIN                                                    10521977
         DC    C') '                                                    10521978
         BC    15,INOFS                                                 10521979
ONKEY    LR    3,2                                                      10521980
         LA    4,1                                                      10521981
         LA    5,3(2)                                                   10521982
LOP      CLI   0(3),X'F0'                                               10521983
         BC    4,LG4                                                    10521984
         CLI   0(3),X'F9'                                               10521985
         BC    2,LG4                                                    10521986
         BXH   3,4,CBN                                                  10521987
         CLI   0(3),C'/'                                                10521988
         BC    8,CBN+16                                                 10521989
         CLI   0(3),C' '                                                10521990
         BC    7,LOP                                                    10521991
         BC    8,CBN+16                                                 10521992
CBN      CLI   0(3),C'/'                                                10521993
         BC    8,*+12                                                   10521994
         CLI   0(3),C' '                                                10521995
         BC    7,LG4                                                    10521996
         LR    5,2                                                      10521997
         LR    2,3                                                      10521998
         BCTR  3,0                                                      10521999
         SR    3,5                                                      10522000
         AH    3,N112                                                   10522001
         STC   3,*+5                                                    10522002
         PACK  TEMP(8),0(0,5)                                           10522003
         CVB   3,TEMP                                                   10522004
         STH   3,6(7)                                                   10522005
INOFS    LH    3,NOFS         INCREASE NOFS BY 1                        10522006
         AH    3,N1                                                     10522007
         STH   3,NOFS                                                   10522008
         TM    0(7),X'10'     IS KEY SPECIFIED                          10522009
         AH    7,N12          INCREASE REGISTER 7 BY 12                 10522010
         BC    8,CONT         NO                                        10522011
         CLI   0(2),C'/'      IS '/'                                    10522012
         BC    7,*+12         NO                                        10522013
         LA    2,1(2)                                                   10522014
         BC    15,FSIN        YES, BRANCH TO FSIN                       10522015
         CLI   0(2),C' '      IS BLANK                                  10522016
         BC    7,LG4          NO, ILLEGAL FORMAT                        10522017
         BC    15,INPUT       YES, READ NEXT CARD                       10522018
CONT     CLI   1(2),C'/'      IS '/'                                    10522019
         BCTR  2,0                                                      10522020
         BC    7,INPUT        NO, READ NEXT CARD                        10522021
         LA    2,2(2)                                                   10522022
         BC    15,FSIN                                                  10522023
*                                                                       10522024
***   HEADER CARD                                                       10522025
*                                                                       10522026
HD       MVC   HEAD(74),CRDAR+6    STORE HEADING LINE                   10522027
         BC    15,INPUT                                                 10522028
HDSD     MVC   HEAD+74(70),CRDAR+6 STORE HEADING LINE                   10522029
         BC    15,INPUT                                                 10522030
*                                                                       10522031
***   CONSTANT                                                          10522032
*                                                                       10522033
         CNOP  0,8                                                      10522034
CCB      DC    F'0'                                                     10522035
         DC    X'0004'                                                  10522036
         DC    YL2(CCW)                                                 10522037
CCW      DC    X'02'                                                    10522038
         DC    AL3(CRDAR)                                               10522039
         DC    X'00000050'                                              10522040
CCBL     DC    F'0'                                                     10522041
         DC    X'0014'                                                  10522042
         DC    YL2(CCWL)                                                10522043
CCWL     DC    X'09'                                                    10522044
         DC    AL3(LOGAR)                                               10522045
         DC    X'00000050'                                              10522046
TEMP     DS    D                                                        10522047
N64K     DC    X'0000FFFF'                                              10522048
N1       DC    X'0001'                                                  10522049
N12      DC    X'000C'                                                  10522050
N112     DC    X'0070'                                                  10522051
CRDAR    DS    CL80                                                     10522052
         DC    C' '                                                     10522053
LOGAR    DS    CL39                                                     10522054
FSW      DC    X'00'                                                    10522055
REQPA    DC    X'00'                                                    10522056
HD1      DC    CL3'// '                                                 10522057
HD2      DC    CL3'FS '                                                 10522058
HD3      DC    CL3'H1 '                                                 10522059
HD4      DC    CL3'H2 '                                                 10522060
HD5      DC    CL3'END'                                                 10522061
HD6      DC    CL3'A=('                                                 10522062
HD7      DC    CL2'K='                                                  10522063
HD8      DC    CL2'D='                                                  10522064
HD9      DC    CL3'B=('                                                 10522065
HD10     DC    CL3'(K,'                                                 10522066
HD11     DC    CL3'Q=('                                                 10522067
MSSG1    DC    C'END CARD MISSING'                                      10522068
MSSG2    DC    C'  ILLEGAL FORMAT'                                      10522069
         DC    C'. UTILITY MODIFI'                                      10522070
         DC    C'ER CARD'                                               10522071
MSSG3    DC    C'FIELD SELECT CAR'                                      10522072
         DC    C'D MISSING'                                             10522073
MSSG4    DC    C'    ILLEGAL FORM'                                      10522074
         DC    C'AT. FIELD SELECT'                                      10522075
         DC    C' CARD'                                                 10522076
MSSG5    DC    C'FIELD SELECT CAR'                                      10522077
         DC    C'D NOT EXPECTED'                                        10522078
MSSG6    DC    C'INVALID CONTROL '                                      10522079
         DC    C'CARD'                                                  10522080
         ORG   SORS+4078                                                10522081
NOFS     DS    H                                                        10522082
         END   STRT                                                     10522083
         TITLE 'PHASE 2  TAPE TO PRINT'                                 10522084
STAR     START 2752                                                     10522085
START    BALR  15,0                                                     10522086
         USING *,15                                                     10522087
SORS     EQU   2500                                                     10522088
QORS     EQU   2504                                                     10522089
IRCLN    EQU   2508                                                     10522090
IBKSZ    EQU   2510                                                     10522091
ORCLN    EQU   2512                                                     10522092
OBKSZ    EQU   2514                                                     10522093
TPGM     EQU   2516                                                     10522094
TJOB     EQU   2517                                                     10522095
FRCD     EQU   2518                                                     10522096
DOPTN    EQU   2519                                                     10522097
POPTN    EQU   2520                                                     10522098
LABSW    EQU   2521                                                     10522099
ICU      EQU   2522                                                     10522100
OCU      EQU   2523                                                     10522101
IBKC     EQU   2524                                                     10522102
OBKC     EQU   2528                                                     10522103
LABIH    EQU   2532                                                     10522104
LABOH    EQU   2534                                                     10522105
LABIT    EQU   2536                                                     10522106
LABOT    EQU   2538                                                     10522107
LABOR    EQU   2540                                                     10522108
AAST     EQU   2542                                                     10522109
LABRTN   EQU   2544                                                     10522110
IPA      EQU   2546                                                     10522111
OPA      EQU   2548                                                     10522112
INA      EQU   2550                                                     10522113
INB      EQU   2552                                                     10522114
OUTA     EQU   2554                                                     10522115
OUTB     EQU   2556                                                     10522116
UCLIM    EQU   2558                                                     10522117
SWHD     EQU   2560                                                     10522118
NOIO     EQU   2561                                                     10522119
DSTBL    EQU   2706                                                     10522120
*                                                                       10522121
****TAPE TO PRINT                                                       10522122
*                                                                       10522123
*                                                                       10522124
***      MAIN LINE DIAGNOSTIC ROUTINE                                   10522125
*                                                                       10522126
FIRSTY   LA    8,ERRTN                                                  10522127
         LA    7,ER00                  PRINT PROGRAM NAME               10522128
         BALR  14,8                                                     10522129
         TM    TJOB,X'10'              TYPE DISPLAY                     10522130
         BC    8,*+10                                                   10522131
         MVC   ORCLN(4),DISP           MOVE 120 TO ORCLM AND OBKSZ      10522132
         TM    TJOB,X'DF'              ANYTHING BUT L OR LF             10522133
         BC    5,*+10                                                   10522134
         MVN   DOPTN(1),DISP+1         SET OUTPUT OPTION TO PRINT CHAR  10522135
         LH    11,ZERO                  ZERO ERROR COUNTER              10522136
         LH    1,20                    COMMUNICATION REG ADDRESS        10522137
         SR    2,2                     ZERO REG 2                       10522138
         IC    2,9(1)                  GET CONFG BYTE                   10522139
         SRL   2,5                                                      10522140
         LH    1,ATEK                                                   10522141
         SLL   1,0(2)                  AMOUNT OF CORE AVAILABLE         10522142
         SH    1,ONE                                                    10522143
         TM    0(1),X'5C'              ASTERISK  IF YES NO LABELS       10522144
         BC    1,SUBT                                                   10522145
         OI    LABSW,X'20'             SET LABEL ECIST SWITCH           10522146
REPEAT   SH    1,ATEY3                 POINT TO THE NEXT LOCATI         10522147
         TM    0(1),X'5C'              IS IT AN ASTERISK                10522148
         BC    12,REPEAT                                                10522149
SUBT     STH   1,AAST                  STORE THE ASTERISK ADDRE         10522150
         STC   1,ER00                  TEST FOR HALF WORD ALIGNMENT     10522151
         TM    ER00,X'01'              IS IT ODD ALIGNMENT              10522152
         BC    8,SUBTRT                                                 10522153
         SH    1,ONE                   ALLIGN ON A  AHLF WORD BOUNDARY  10522154
SUBTRT   SH    1,TWO                   SUBT INST LENGTH                 10522155
         MVC   0(2,1),BRANCH           MOVE   BRANCH TO PHASE 4         10522156
         STH   1,UCLIM                 STORE ADDRESS                    10522157
         TM    TPGM,X'28'              TAPE TO PRINT                    10522158
         BC    1,A1                                                     10522159
         LA    7,ER0                    LOAD  ADDRESS                   10522160
         BALR  14,8                    GO TO ERROR ROUTINE              10522161
A1       LH    1,22                     REG 1 CONTAINS THE PUB ADDRESS  10522162
         TM    3(1),X'FF'              MORE THAN 1 TAPE UNIT            10522163
ZETA     BC    5,EXTRA                 FOR INPUT                        10522164
         TM    14(1),X'FF'             TAPE INPUT                       10522165
         BC    8,A2                                                     10522166
         LA    7,ER1                    LOAD  ADDRESS                   10522167
         BALR  14,8                    GO TO ERROR ROUTINE              10522168
A2       CLI   18(1),X'06'             SYSOPT 1403 PRINTER              10522169
         BC    8,A3                                                     10522170
         CLI   18(1),X'12'             SYSOPT 1443 PRINTER              10522171
         BC    8,A3                                                     10522172
         LA    7,ER2                    LOAD  ADDRESS                   10522173
         BALR  14,8                    GO TO ERROR ROUTINE              10522174
A3       TM    TJOB,X'CF'              TYPE L,LF, OR D                  10522175
         BC    8,A4                                                     10522176
         OI    SWIT,X'20'              SET INVALID PROG TYPE SWIT       10522177
         LA    7,ER6                    LOAD  ADDRESS                   10522178
         BALR  14,8                    GO TO ERROR ROUTINE              10522179
A4       TM    TJOB,X'10'              TYPE DISPLAY                     10522180
         BC    8,TESTY                                                  10522181
A5       TM    DOPTN,X'F0'             VALID INPUT OPTION               10522182
         BC    4,A6                                                     10522183
         OI    SWIT,X'02'              INVALID INPUT  OPTION            10522184
         LA    7,ER11                   LOAD  ADDRESS                   10522185
         BALR  14,8                    GO TO ERROR ROUTINE              10522186
A6       TM    TJOB,X'10'              DATA DIAPLAY                     10522187
         BC    1,A6A                                                    10522188
         TM    DOPTN,X'08'             OUTPUT CHARACTER                 10522189
         BC    1,A7                                                     10522190
         BC    15,OOPS                                                  10522191
A6A      TM    DOPTN,X'0C'             OUTPUT EITHER HEX OR CHARACTER   10522192
         BC    4,A7                                                     10522193
OOPS     OI    SWIT,X'08'              INVALID OUTPUT OPTION            10522194
         LA    7,ER12                   LOAD  ADDRESS                   10522195
         BALR  14,8                    GO TO ERROR ROUTINE              10522196
A7       TM    FRCD,X'06'              VARIABLE OR UNDEFINED RECORDS    10522197
         BC    4,A9                                                     10522198
         CLC   IRCLN(2),FOR096         IRL GREATER THAN 4096            10522199
         BC    13,A8                   NO                               10522200
         LA    7,ER7                    LOAD  ADDRESS                   10522201
         BALR  14,8                    GO TO ERROR ROUTINE              10522202
A8       LH    3,IBKSZ                 IBKSZ = K(IRL)                   10522203
         N     3,ANDOP                                                  10522204
         SR    2,2                                                      10522205
         LH    1,IRCLN                 GET RECORD LENGTH TO DIVIDE      10522206
         DR    2,1                                                      10522207
         LTR   2,2                     REMAINDER = 0                    10522208
         BC    8,A9                                                     10522209
         LA    7,ER8                                                    10522210
         BALR  14,8                    GO TO ERROR ROUTINE              10522211
A9       CLC   ORCLN(2),ONE44          ORL GREATER THAN 144             10522212
         BC    13,A10                                                   10522213
         LA    7,ER9                    LOAD  ADDRESS                   10522214
         BALR  14,8                    GO TO ERROR ROUTINE              10522215
A10      CLC   OBKSZ(2),ORCLN                                           10522216
         BC    8,A11                                                    10522217
         LA    7,ER10                   LOAD  ADDRESS                   10522218
         BALR  14,8                    GO TO ERROR ROUTINE              10522219
A11      CLC   IRCLN(2),ORCLN          IRL EQUAL ORL                    10522220
         BC    13,SPACE                                                 10522221
         TM    TJOB,X'12'              DATA DISPLAY OR FIELD SELECT     10522222
         BC    4,SPACE                                                  10522223
         TM    TJOB,X'FF'               LIST AND FIELS SELECT           10522224
         BC    8,SPACE                                                  10522225
         LA    7,ER26                                                   10522226
         BALR  14,8                                                     10522227
SPACE    BC    15,RP                                                    10522228
TESTY    TM    FRCD,X'01'              FIXED LENGTH INPUT               10522229
         BC    1,A5                                                     10522230
         LA    7,ER5                                                    10522231
         BALR  14,8                                                     10522232
         BC    15,A5                                                    10522233
EXTRA    CLC   25(2,1),ZERO            IS THE UNIT ASSIGNED             10522234
         BC    8,ZETA+4                                                 10522235
         MVI   IPA+1,X'18'             MOVE ALTERNATE INPUT DEVICE DSP  10522236
         TM    26(1),X'FF'                                              10522237
         BC    8,ZETA+4                YES                              10522238
         LA    7,ER1                   NON TAPE UNIT MESSAGE            10522239
         BALR  14,8                                                     10522240
         BC    15,ZETA+4                                                10522241
ERRTN    MVC   ER00(36),0(7)           MOVE MESSAGE TO PRINT AREA       10522242
         AH    11,ONE                   ADD 1 TO ERROR COUNTER          10522243
         SH    7,ONE                                                    10522244
         MVC   COM+7(1),0(7)           MOVE LENGTH TO BE PRINTED        10522245
         SVC   0                                                        10522246
         DC    YL2(CCB)                                                 10522247
         TM    CCB+2,X'80'              WRITE FINISHED                  10522248
         BC    8,*-4                                                    10522249
         BCR   15,14                                                    10522250
*                                                                       10522251
***      MAIN LINE                                                      10522252
*                                                                       10522253
RP       LH    9,UCLIM                                                  10522254
         SR    1,1                                                      10522255
         SR    10,10                                                    10522256
         TM    TJOB,X'20'              LIST                             10522257
         BC    1,REBL                  TREAT A LIST LIKE A REBLOCK      10522258
         TM    TJOB,X'FF'              LIST W/ FIELD SELECT             10522259
         BC    5,GEE2                                                   10522260
         LH    0,NOFS                                                   10522261
***  THIS REGISRER IS USED TO NUMBER THE FIELD SELECT ERROR MESSAGES    10522262
         LR    10,0                    GET CURRENT FS CARD ENTRY FROM   10522263
         LA    10,1(10)                ADD ONE TO REG 10                10522264
         LR    1,0                     GET THE NUMBER OF FS ENTRIES     10522265
         BCTR  1,0                                                      10522266
         MH    1,TWELVE                POINT TO THE LAST ONE            10522267
RP3      SH    0,ONE                   SUBT 1 FROM NOFS                 10522268
         BCTR  10,0                    POINT TO THE NEXT ENTRY          10522269
         LA    7,NOFS+2(1)                                              10522270
         TM    0(7),X'60'              TRANSLATE TO HEX                 10522271
         BC    1,TRANS1                                                 10522272
         TM    0(7),X'40'              UNPACK                           10522273
         BC    1,CC                                                     10522274
         TM    0(7),X'20'              IS IT PACK                       10522275
         BC    1,WRONG                                                  10522276
         MVC   ER16+32(4),ER43         MOVE FS TO ERROR MESSAGE         10522277
         MVC   ER31+4(4),ER43                                           10522278
         L     4,NOFS+10(1)                4          B                 10522279
         LR    6,4                                                      10522280
ZUTI     LH    2,NOFS+6(1)             REG 2 CONTAINS A                 10522281
         LH    3,NOFS+8(1)                 3          C                 10522282
         BCTR  2,0                                                      10522283
         BCTR  3,0                                                      10522284
         LTR   4,4                     N EQUAL ZERO TEST                10522285
         BC    8,UDOPE                                                  10522286
         TM    0(7),X'60'              TRANSLATE                        10522287
         BC    1,TRANS                                                  10522288
         LR    5,2                                                      10522289
         LR    7,3                                                      10522290
         AR    5,4                                                      10522291
         AR    7,6                                                      10522292
         CH    5,IRCLN                                                  10522293
         BC    2,ERRORA                                                 10522294
         CH    7,ORCLN                                                  10522295
         BC    2,ERRORA                                                 10522296
         LA    3,1(3)                                                   10522297
         LA    2,1(2)                                                   10522298
         LA    7,NOFS+2(1)                                              10522299
         TM    0(7),X'40'              UNPACK                           10522300
         BC    1,Z                                                      10522301
         BAL   14,GG                                                    10522302
         BC    15,L                                                     10522303
TRANS1   MVC   ER16+32(4),ER42         MOVE HEX TO ERROR MESSAGE        10522304
         MVC   ER31+4(4),ER42                                           10522305
         BC    15,ZUTI-6                                                10522306
L        CH    0,ZERO                  ALL FS PARAMETERS PROCESSDD      10522307
         BC    2,ADER                                                   10522308
GEE2     STH   9,UCLIM                 STORE INST ADDRESS               10522309
         TM    ICU,X'FF'               DID USER SUPPLY OWN LABELS       10522310
         BC    12,MAXIY                NO                               10522311
LABEL    SH    9,LABRTN                                                 10522312
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10522313
         BC    15,MAXY                                                  10522314
MAXIY    TM    LABSW,X'20'             IS THERE LABEL CHECKING          10522315
         BC    8,LABEL                                                  10522316
         TM    DOPTN,X'10'             YES - MULTIPLE REEL FILES        10522317
         BC    1,*+18                  YES                              10522318
         SH    9,INA                   SUBT LAST ADDR OF IPT TRAIL LAB  10522319
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10522320
         BC    15,MAXY                                                  10522321
         SH    9,LABIT                 SUBT ADDR OF PH3 IN LABEL RTN    10522322
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10522323
MAXY     STH   9,MAXIO                 STORE AVAILABLE CORE FOR I/O     10522324
         BC    15,ASSIGN                                                10522325
REBL     LH    4,IRCLN                 USE RECORD LENGTH FOR LENGTH     10522326
         LH    2,ONE                                                    10522327
         LR    3,2                     GET STARTING PARAMETERS          10522328
         BAL   14,GG                   GO TO REBLOCK ROUTINE            10522329
         BC    15,GEE2                                                  10522330
ADER     SH    1,TWELVE                                                 10522331
         BC    15,RP3                                                   10522332
CC       LH    4,NOFS+10(1)            REG 4 CONTAINS N                 10522333
         LH    6,NOFS+12(1)                6          M                 10522334
UNPKR    MVC   ER16+32(4),ER44         MOVE UNPK TO ERROR MESSAGE       10522335
         MVC   ER31+4(4),ER44                                           10522336
         BC    15,ZUTI                                                  10522337
ERRORA   LA    7,ER16                  LOAD ERROR MESSAGE               10522338
         BAL   14,CVD                                                   10522339
         UNPK  ER16(3),OUTARA(8)                                        10522340
         BALR  14,8                                                     10522341
         BC    15,L                                                     10522342
UDOPE    LA    7,ER31                  N EQUALS ZERO                    10522343
         BAL   14,CVD                                                   10522344
         UNPK  ER31(3),OUTARA(8)                                        10522345
         BALR  14,8                                                     10522346
         BC    15,L                                                     10522347
WRONG    LA    7,ERWR                                                   10522348
         BAL    14,CVD                                                  10522349
         UNPK  ERWR(3),OUTARA(8)                                        10522350
         BALR  14,8                                                     10522351
         BC    15,L                                                     10522352
*                                                                       10522353
***      UNPACK ROUTINE                                                 10522354
*                                                                       10522355
Z        LH    2,NOFS+6(1)                                              10522356
         LH    3,NOFS+8(1)                                              10522357
         LH    4,NOFS+10(1)                                             10522358
         LH    5,NOFS+12(1)                                             10522359
         AH    2,XSIX                                                   10522360
         AH    3,XTEN                                                   10522361
         BCTR  2,0                                                      10522362
         BCTR  3,0                                                      10522363
         STH   2,UNPK2+4                 STORE A,C IN UNPACK2           10522364
         STH   3,UNPK2+2                                                10522365
         STH   3,MVI+2                                                  10522366
         STH   3,MVC+4                                                  10522367
         AH    3,ONE                                                    10522368
         STH   3,MVC+2                                                  10522369
         BCTR  3,0                                                      10522370
         CH    4,EIGHT                  N LESS OR EQUAL TO 8            10522371
         BC    12,LES                                                   10522372
         AR    2,4                      A AND C NOW POINT TO THE LAST   10522373
         AR    3,5                      BYTE +1 OF THEIR AREAS          10522374
         BCTR  2,0                                                      10522375
         BCTR  3,0                                                      10522376
ALPHA    CH    4,EIGHT                  N LESS OR EQUAL TO 8            10522377
         BC    12,LES                                                   10522378
         SH    2,SEVEN                                                  10522379
         SH    3,FORTEN                  SUBT 7,14 FROM A,C , N,M       10522380
         SH    4,SEVEN                                                  10522381
         SH    5,FORTEN                                                 10522382
         STH   2,UNPK1+4                                                10522383
         STH   3,UNPK1+2                                                10522384
         SH    9,SIX                    MOVE TO                         10522385
         MVC   0(6,9),UNPK1             UPPER CORE                      10522386
         BC    15,ALPHA                                                 10522387
LES      CH    5,ONE                   M LESS THAN ONE                  10522388
         BC    4,ERRO                                                   10522389
         CH    5,SIXTEN                M GREATER THAN 16                10522390
         BC    12,GEBER1                                                10522391
         CH    5,TWO56                 M GREATER THAN 256               10522392
         BC    2,ERRO                                                   10522393
         SH    5,ONE                   SUBT ONE FROM M                  10522394
         STC   5,MVC+1                   STORE LENGTH                   10522395
         SH    3,FORTEN                  SUBT 14 FROM C                 10522396
         STH   3,UNPK2+2               STORE C AND REGS IN INST         10522397
         SH    4,ONE                   SUBT ONE FROM N                  10522398
         STC   4,UNPK2+1                 STORE N                        10522399
         MVZ   UNPK2+1(1),UNPK1+1      STORE M IN LENGTH                10522400
         SH    9,SIXTEN                  SUBT INST LENGTH               10522401
         MVC   0(16,9),MVI               MOVE TO UPPER CORE             10522402
         BC    15,L                                                     10522403
GEBER1   SH    4,ONE                   SUBT ONE FROM(N,M)               10522404
         SH    5,ONE                                                    10522405
ASTER    SLA   5,4                      GET ONE BYTE LENGTH MIN         10522406
         AR    5,4                                                      10522407
         STC   5,UNPK2+1                LENGTH IS STORED                10522408
         SH    9,SIX                                                    10522409
         MVC   0(6,9),UNPK2                                             10522410
         BC    15,L                                                     10522411
*                                                                       10522412
***    GENERATE ROUTINE FOR FIELD SELECT AND REBLOCKING                 10522413
*                                                                       10522414
GG       LH    5,TWO56                 REG 5 CONTAINS 256               10522415
         LR    7,5                          7          255              10522416
         SH    7,ONE                                                    10522417
         AH    2,XSIX                                                   10522418
         AH    3,XTEN                                                   10522419
         BCTR  2,0                                                      10522420
         BCTR  3,0                                                      10522421
BACK     CR    4,5                      B LESS OR EQUAL TO 256          10522422
         BC    12,LAST                                                  10522423
         STH   2,MOVE+4                 NO - STORE A AND C              10522424
         STH   3,MOVE+2                                                 10522425
         AR    2,5                      ADD 256 TO A AND C              10522426
         AR    3,5                                                      10522427
         STC   7,MOVE+1                 STORE 255 IN DUMMY INST         10522428
         SR    4,5                      SUBT  256 FROM B                10522429
         SH    9,SIX                   SUBT INST LENGTH                 10522430
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10522431
         BC    15,BACK                                                  10522432
LAST     STH   2,MOVE+4                GENERATE LAST MOVE               10522433
         STH   3,MOVE+2                                                 10522434
         SH    4,ONE                   SUBT ONE FROM B                  10522435
         STC   4,MOVE+1                                                 10522436
         SH    9,SIX                   SUBT INST LENGTH                 10522437
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10522438
         BCR   15,14                    RETURN                          10522439
*                                                                       10522440
***      TRANSLATE ROUTINE                                              10522441
*                                                                       10522442
TRANS    LH    2,NOFS+6(1)             REG 2 CONTAINS A                 10522443
         LH    3,NOFS+8(1)                 3          C                 10522444
         BCTR  2,0                                                      10522445
         BCTR  3,0                                                      10522446
         L     4,NOFS+10(1)                4          B                 10522447
         LR    5,4                                                      10522448
         AR    5,2                                                      10522449
         CH    5,IRCLN                                                  10522450
         BC    13,GO1ON                                                 10522451
         BC    15,ERRORA                                                10522452
GO1ON    AR    4,4                                                      10522453
         LR    5,4                                                      10522454
         AR    5,3                                                      10522455
         CH    5,ORCLN                                                  10522456
         BC    13,GO2ON                                                 10522457
         BC    15,ERRORA                                                10522458
GO2ON    AH    3,XTEN                                                   10522459
ZEROX    CH    4,TWO56                 B GREATER THAN 256               10522460
         BC    13,ENDFIN                                                10522461
         STH   3,TR1+2                 STORE ADDRESS IN INST            10522462
         SH    9,SIX                                                    10522463
         MVC   0(6,9),TR1              MOVE TO UPPER CORE               10522464
         SH    4,TWO56                 SUBT 256 DROM B                  10522465
         AH    3,TWO56                 ADD 256 TO C                     10522466
         BC    15,ZEROX                                                 10522467
ENDFIN   SH    4,ONE                   SUBT 1 FROM LENGTH               10522468
         STC   4,TR+1                  STORE PARAMETERS                 10522469
         STH   3,TR+2                                                   10522470
         SH    9,SIX                   SUBT INST LENGHT                 10522471
         MVC   0(6,9),TR               MOVE TO UPPER CORE               10522472
         LH    2,NOFS+6(1)             SET REGS FOR                     10522473
         LH    3,NOFS+8(1)             UNPACK                           10522474
         L     4,NOFS+10(1)                                             10522475
         LR    5,4                                                      10522476
         AR    5,5                                                      10522477
         BCTR  5,0                                                      10522478
         LR    7,5                                                      10522479
         AR    7,3                                                      10522480
         BCTR  7,0                                                      10522481
         AH    7,XTEN                                                   10522482
         STH   7,PACK3+2               STORE ADDRESS                    10522483
         STH   7,ORI1+2                                                 10522484
         SH    7,ONE                   REG 7 CONTQINS 2B+(C-2)          10522485
         STH   7,PACK3+4                                                10522486
         STH   7,ORI+2                                                  10522487
         SH    9,FORTEN                                                 10522488
         MVC   0(14,9),PACK3           MOVE INSTRUCTIONS TO UPPER CORE  10522489
         BC    15,Z+16                                                  10522490
*                                                                       10522491
***     ASSIGN  IO  AREAS                                               10522492
*                                                                       10522493
ASSIGN   OI    SWIT,X'01'                                               10522494
         LH    2,TWO                                                    10522495
         LH    1,MAXIO                 A EQUALS 2,IO LIMIT IS IN REG 1  10522496
         N     1,ANDOP                 GET RID OF MINUS PROROGATION     10522497
         LR    3,2                          B=2                         10522498
         LH    10,OBKSZ                                                 10522499
         LH    9,IBKSZ                 GET INKSZ IN REG 9               10522500
         N     10,ANDOP                                                 10522501
         N     9,ANDOP                 GET RID OF MINUS                 10522502
RETURN   LR    7,3                                                      10522503
         LR    5,2                                                      10522504
         MR    6,10                                                     10522505
         MR    4,9                                                      10522506
         AR    5,7                                                      10522507
         CR    5,1                                                      10522508
         BC    12,ASGN                 ASSIGN AREAS IF POSSIBLE         10522509
TEST     TM    SWIT,X'01'                   SWITCH ON TEST              10522510
         BC    1,ON                                                     10522511
         OI    SWIT,X'01'                   TURN SWITCH ON              10522512
         SH    3,ONE                   SUBT ONE FROM B                  10522513
         AH    2,ONE                   ADD ONE TO A                     10522514
         LTR   3,3                     B LESS THAN ZERO TEST            10522515
         BC    4,ERROR                      YES                         10522516
         BC    15,RETURN                    NO                          10522517
ON       NI    SWIT,X'FE'                   TURN SWITCH OFF             10522518
         SH    2,ONE                   SUBT ONE FROM A                  10522519
         BC    15,RETURN                                                10522520
ERROR    LA    8,ERRTN                                                  10522521
         LA    7,ER14                   LOAD  ADDRESS                   10522522
         OI    SWIT,X'04'              SET SUPRESS I/O PRINT SWITCH     10522523
         BALR  14,8                    GO TO ERROR ROUTINE              10522524
GOERT    STH   11,FOR096               STORE NUMBER OF ERRORS           10522525
         BC    15,ENDLOG                                                10522526
*                                                                       10522527
***   ACTUAL ASSIGNING OF INPUT OUTPUT AREAS                            10522528
*                                                                       10522529
ASGN     LTR   3,3                                                      10522530
CHANGE   BC    8,TEST                  CN NOT ASSGN I/O AREAS           10522531
         LH    6,ZERO                  THIS ADDRESS IS MODIFIED         10522532
         BC    8,STOR3                 IF ZERO, A = 0                   10522533
         STH   6,INA                   STORE ASDRESS IN INA             10522534
         SH    2,ONE                   SUBT ONE FROM A                  10522535
         LTR   2,2                     TEST FOR A ' ZERO                10522536
         BC    8,STOR                                                   10522537
         AR    6,9                                                      10522538
STOR     STH   6,INB                   STOR ADDRESS IN INB              10522539
         LTR   3,3                     B = 0 TEST                       10522540
         BC    8,STOR2                                                  10522541
         AR    6,9                                                      10522542
         STH   6,OUTA                                                   10522543
         SH    3,ONE                                                    10522544
         LTR   3,3                     B = 0 TEST                       10522545
         BC    8,STOR1                                                  10522546
         AR    6,10                                                     10522547
STOR1    STH   6,OUTB                  STORE ADDRESS IN OUT B           10522548
         BC    15,LOG                                                   10522549
STOR2    MVC   INA(2),OUTA             COMBINED I/O AREAS               10522550
         MVC   INB(2),OUTB             MAKE IN AND OUT CORRESPOND       10522551
         BC    15,LOG                                                   10522552
STOR3    STH   6,INA                   STORE ADDRESS IN                 10522553
         STH   6,OUTA                  INA AND POUT A                   10522554
         BCTR  2,0                                                      10522555
         LTR   2,2                                                      10522556
         BC    8,STOR4                 B = 0 TEST                       10522557
         AR    6,10                                                     10522558
STOR4    STH   6,INB                                                    10522559
         STH   6,OUTB                                                   10522560
LOG      SR    7,7                     CLEAR REG 7 TO ZERO              10522561
         CLC   INA(2),INB                                               10522562
         BC     8,*+8                  /NA EQUAL INB  ADD ONLY 16       10522563
         AH    7,SIXTEN                                                 10522564
         AH    7,SIXTEN                                                 10522565
         CLC    OUTA(2),OUTB                                            10522566
         BC    8,*+8                   OUTA EQUAL OUTB  ADD ONLY 1      10522567
         AH     7,ONE                                                   10522568
         AH     7,ONE                                                   10522569
         STC    7,NOIO                                                  10522570
         BC    15,GOERT                                                 10522571
*                                                                       10522572
***      LOG JOB ROUTINE                                                10522573
*                                                                       10522574
ENDLOG   LH    6,IRCLN                                                  10522575
         MVI   CVD+1,X'60'             CHANGE THE REGISTER IN THE CVD   10522576
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10522577
         BC    4,*+20                  BYPASS RECORD FORMAT PRINT       10522578
         BAL   14,CVD                                                   10522579
         UNPK  ER18+20(4),OUTARA(8)                                     10522580
         LA    7,ER18                                                   10522581
         BALR  14,8                    GO TO ERROR ROUTINE              10522582
         LH    6,IBKSZ                                                  10522583
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10522584
         BAL   14,CVD                                                   10522585
         UNPK  ER19+17(5),OUTARA(8)          IBKSZ                      10522586
         LA    7,ER19                                                   10522587
         BALR  14,8                    GO TO ERROR ROUTINE              10522588
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10522589
         BC    4,*+24                  BYPASS RECORD FORMAT PRINT       10522590
         LH    6,ORCLN                                                  10522591
         BAL   14,CVD                                                   10522592
         UNPK  ER20+22(4),OUTARA(8)                                     10522593
         LA    7,ER20                                                   10522594
         BALR  14,8                    GO TO ERROR ROUTINE              10522595
         LH    6,OBKSZ                                                  10522596
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10522597
         BAL   14,CVD                                                   10522598
         UNPK  ER21+18(5),OUTARA(8)      OBKSZ                          10522599
         LA    7,ER21                                                   10522600
         BALR  14,8                    GO TO ERROR ROUTINE              10522601
         TM    SWIT,X'02'              TEST FOR INVALID INPUT OPTION    10522602
         BC    1,TM                                                     10522603
         TM    DOPTN,X'20'             NO REWIND,UNLOAD                 10522604
         BC    8,*+14                                                   10522605
         MVC   ER22+13(16),ER46        MOVE MESSAGE TO MASTER           10522606
         BC    15,PRINTZ               GO WRITE                         10522607
         TM DOPTN,X'10'                TAPE MULTIPLE                    10522608
         BC    8,*+14                                                   10522609
         MVC   ER22+13(13),ER45A       MOVW MESSSAGE TO MASTER          10522610
         BC    15,PRINTZ               GO WRITE                         10522611
         TM    DOPTN,X'40'             TAPE REWIND                      10522612
         BC    8,*+14                                                   10522613
         MVC   ER22+13(11),ER49        MOVE MESSAGE TO MASTER           10522614
         BC    15,PRINTZ               GO WRITE                         10522615
         MVC   ER22+13(18),ER50        TAPE REWIND UNLOAD               10522616
PRINTZ   LA    7,ER22                                                   10522617
         BALR  14,8                                                     10522618
TM       TM    SWIT,X'08'              TEST FOR INVALID OUTPUT OPTION   10522619
         BC    1,RETUNR+6                                               10522620
         TM    DOPTN,X'04'             PRINT HEXADECIMAL                10522621
         BC    8,*+14                                                   10522622
         MVC   ER23+14(9),ER48         POVE MESSAGE TO MASTER           10522623
         BC    15,RETUNR                                                10522624
         MVC   ER23+14(15),ER47        PRINT CHARACTER                  10522625
RETUNR   LA    7,ER23                                                   10522626
         BALR  14,8                    GO TO ERROR ROUTINE              10522627
         TM    SWIT,X'04'              TEST SUPRESS I/O PRINT SWITCH    10522628
         BC    1,LOADZ+6                                                10522629
         TM    NOIO,X'02'               2 OUTPUT                        10522630
         BC    1,STORTO                                                 10522631
         MVI   ER24+8,X'F1'            PUT 1 IN OUTPUT                  10522632
ZERT     TM    NOIO,X'20'               2 INPUT                         10522633
         BC    1,STORTT                                                 10522634
         MVI   ER24,X'F1'              PUT 1 IN INPUT                   10522635
LOADZ    LA    7,ER24                                                   10522636
         BALR  14,8                    GO TO ERROR ROUTINE              10522637
         TM    FRCD,X'01'              FIXED INPUT                      10522638
         BC    1,FIXED                                                  10522639
         TM    FRCD,X'02'              VARIABLE INPUT                   10522640
         BC    1,VAR                                                    10522641
         MVC   ER32+14(9),ER40         MOVE UNDEFINED TO MESSAGE        10522642
LO       LA    7,ER32                                                   10522643
         BALR  14,8                                                     10522644
         TM    SWIT,X'20'              INVALID PROGRAM TYPE             10522645
         BC    1,WRITE+6                                                10522646
         TM    TJOB,X'10'              DATA DISPLAY                     10522647
         BC    8,*+14                                                   10522648
         MVC   ER33+5(12),ER39G                                         10522649
         BC    15,WRITE                                                 10522650
         TM    TJOB,X'20'              LIST                             10522651
         BC    8,*+14                                                   10522652
         MVC   ER33+5(4),ER39E                                          10522653
         BC    15,WRITE                                                 10522654
         MVC   ER33+5(17),ER39F        LIST AND FIELD DELECT            10522655
WRITE    LA    7,ER33                                                   10522656
         BALR  14,8                                                     10522657
         L     6,SORS                                                   10522658
         BAL   14,CVD                                                   10522659
         UNPK  ER34+24(4),OUTARA(8)                                     10522660
         LA    7,ER34                                                   10522661
         BALR  14,8                                                     10522662
         LH    11,FOR096                                                10522663
         CH    11,ZERO                                                  10522664
         BC    8,SVC                                                    10522665
         SVC   1                                                        10522666
         DC    C'SYSEOJ'                                                10522667
SVC      SVC   1                                                        10522668
         DC    C'SYSLOD'                                                10522669
MUV      TM    NOIO,X'02'                                               10522670
         BC    1,STTT                                                   10522671
         MVI   ER25,X'F1'              PUT 1 IN I/O                     10522672
ZIPPY    LA    7,ER25                                                   10522673
         BALR  14,8                    GO TO ERROR ROUTINE              10522674
         BC    15,LOADZ+6                                               10522675
STTT     MVI   ER25,X'F2'              PUT 2 IN I/O                     10522676
         BC    15,ZIPPY                                                 10522677
STORTO   MVI   ER24+8,X'F2'            PUT 2 IN OUTPUT                  10522678
         BC    15,ZERT                                                  10522679
STORTT   MVI   ER24,X'F2'              PUT 2 IN INPUT                   10522680
         BC    15,LOADZ                                                 10522681
CVD      CVD   10,OUTARA               CONVERT TO DECIMAL               10522682
         OI    OUTARA+7,X'0F'          PUT SIGN INTO CONVERTED NUMBER   10522683
         BCR   15,14                                                    10522684
FIXED    MVC   ER32+14(9),ER42A                                         10522685
         BC    15,LO                                                    10522686
VAR      MVC   ER32+14(9),ER41         MOVE VARIABLE TO MESAGE          10522687
         BC    15,LO                                                    10522688
*                                                                       10522689
***      CONSTANTS                                                      10522690
*                                                                       10522691
         CNOP  0,8                                                      10522692
OUTARA   DC    D'0'                                                     10522693
CCB      DC    F'0'                                                     10522694
         DC    X'0014'                                                  10522695
         DC    YL2(COM)                                                 10522696
COM      DC    X'09'                                                    10522697
         DC    AL3(ER00)                                                10522698
         DC    X'20000032'                                              10522699
ANDOP    DC    X'0000FFFF'                                              10522700
MOVE     MVC   0(0,0),0(0)              DUMMY INST                      10522701
BRANCH   BCR   15,7                                                     10522702
UNPK1    UNPK  0(15,0),0(8,0)                                           10522703
MVI      MVI   0(0),X'F0'                                               10522704
MVC      MVC   0(0,0),0(0)                                              10522705
UNPK2    UNPK  0(0,0),0(0,0)                                            10522706
TR1      TR    0(256),DSTBL-240                                         10522707
TR       TR    0(256),DSTBL-240                                         10522708
PACK3    PACK  0(1,0),0(1,0)                                            10522709
ORI      OI    0(0),X'F0'                                               10522710
ORI1     OI    0(0),X'F0'                                               10522711
ERRO     LA    7,ER15                                                   10522712
         BAL   14,CVD                                                   10522713
         UNPK  ER15(3),OUTARA(8)                                        10522714
         BALR  14,8                                                     10522715
         BC    15,L                                                     10522716
XTEN     DC    X'A000'                                                  10522717
XSIX     DC    X'6000'                                                  10522718
ZERO     DC    H'0'                                                     10522719
ONE      DC    X'0001'                                                  10522720
TWO      DC    H'2'                                                     10522721
THREE    DC    H'3'                                                     10522722
SIX      DC    H'6'                                                     10522723
SEVEN    DC    H'7'                                                     10522724
EIGHT    DC    H'8'                                                     10522725
TEN      DC    H'10'                                                    10522726
TWELVE   DC    H'12'                                                    10522727
FORTEN   DC    H'14'                                                    10522728
SIXTEN   DC    H'16'                                                    10522729
ATEY3    DC    H'83'                                                    10522730
ONE44    DC    H'144'                                                   10522731
TWO56    DC    H'256'                                                   10522732
FOR096   DC    H'4096'                                                  10522733
ATEK     DC    H'8192'                                                  10522734
SWIT     DC    X'0000'                                                  10522735
KONST    DC    X'EF00'                                                  10522736
MAXIO    DC    H'0'                                                     10522737
DISP     DC    X'00780078'                                              10522738
         DC    X'20'                                                    10522739
ER00     DC    C'TAPE TO PRINT UT'                                      10522740
         DC    C'ILITY           '                                      10522741
         DC    F'0'                                                     10522742
         DC    X'11'                                                    10522743
ER0      DC    C'INCORRECT PROGRA'                                      10522744
         DC    C'M'                                                     10522745
         DC    X'16'                                                    10522746
ER1      DC    C'INCORRECT INPUT '                                      10522747
         DC    C'DEVICE'                                                10522748
         DC    X'17'                                                    10522749
ER2      DC    C'INCORRECT OUTPUT'                                      10522750
         DC    C' DEVICE'                                               10522751
         DC    X'23'                                                    10522752
ER5      DC    C'FIXED LENGTH REC'                                      10522753
         DC    C'ORD FORMAT REQUI'                                      10522754
         DC    C'RED'                                                   10522755
         DC    X'1C'                                                    10522756
ER6      DC    C'INVALID JOB FOR '                                      10522757
         DC    C'THIS PROGRAM'                                          10522758
         DC    X'1B'                                                    10522759
ER7      DC    C'INVALID INPUT RE'                                      10522760
         DC    C'CORD LENGTH'                                           10522761
         DC    X'1A'                                                    10522762
ER8      DC    C'INVALID INPUT BL'                                      10522763
         DC    C'OCK LENGTH'                                            10522764
         DC    X'1C'                                                    10522765
ER9      DC    C'INVALID OUTPUT R'                                      10522766
         DC    C'ECORD LENGTH'                                          10522767
         DC    X'1B'                                                    10522768
ER10     DC    C'INVALID OUTPUT B'                                      10522769
         DC    C'LOCK LENGTH'                                           10522770
         DC    X'14'                                                    10522771
ER11     DC    C'INVALID INPUT OP'                                      10522772
         DC    C'TION'                                                  10522773
         DC    X'15'                                                    10522774
ER12     DC    C'INVALID OUTPUT O'                                      10522775
         DC    C'PTION'                                                 10522776
         DC    X'1B'                                                    10522777
ER14     DC    C'I/O AREA CANNOT '                                      10522778
         DC    C'BE ASSIGNED'                                           10522779
         DC    X'20'                                                    10522780
ER15     DC    C'    INVALID UNPA'                                      10522781
         DC    C'CK OUTPUT LENGTH'                                      10522782
         DC    X'24'                                                    10522783
ER16     DC    C'    RECORD CAPAC'                                      10522784
         DC    C'ITY EXCEEDED BY '                                      10522785
         DC    C'    '                                                  10522786
         DC    X'1E'                                                    10522787
ER17     DC    C'    INVALID PACK'                                      10522788
         DC    C' OUTPUT LENGTH'                                        10522789
         DC    X'18'                                                    10522790
ER18     DC    C'INPUT RECORD LEN'                                      10522791
         DC    C'GTH     '                                              10522792
         DC    X'16'                                                    10522793
ER19     DC    C'INPUT BLOCK SIZE'                                      10522794
         DC    C'      '                                                10522795
         DC    X'1A'                                                    10522796
ER20     DC    C'OUTPUT RECORD LE'                                      10522797
         DC    C'NGTH      '                                            10522798
         DC    X'17'                                                    10522799
ER21     DC    C'OUTPUT BLOCK SIZ'                                      10522800
         DC    C'E      '                                               10522801
         DC    X'20'                                                    10522802
ER22     DC    C'INPUT OPTION    '                                      10522803
         DC    C'                '                                      10522804
         DC    X'20'                                                    10522805
ER23     DC    C'OUTPUT OPTION   '                                      10522806
         DC    C'                '                                      10522807
         DC    X'1F'                                                    10522808
ER24     DC    C'  INPUT,  OUTPUT'                                      10522809
         DC    C' AREAS ASSIGNED'                                       10522810
         DC    X'20'                                                    10522811
ER25     DC    C'   INPUT / OUTPU'                                      10522812
         DC    C'T AREAS ASSIGNED'                                      10522813
         DC    X'1E'                                                    10522814
ER26     DC    C'FIELD SELECT MUS'                                      10522815
         DC    C'T BE SPECIFIED'                                        10522816
         DC    X'21'                                                    10522817
ER31     DC    C'         INPUT L'                                      10522818
         DC    C'ENGTH EQUALS ZER'                                      10522819
         DC    C'O'                                                     10522820
         DC    X'17'                                                    10522821
ER32     DC    C'RECORD FORMAT   '                                      10522822
         DC    C'       '                                               10522823
         DC    X'1D'                                                    10522824
ER33     DC    C'TYPE            '                                      10522825
         DC    C'             '                                         10522826
         DC    X'1C'                                                    10522827
ER34     DC    C'STARTING RECORD '                                      10522828
         DC    C'NUMBER      '                                          10522829
ER39E    DC    C'LIST'                                                  10522830
ER39F    DC    C'LIST,FIELD SELEC'                                      10522831
         DC    C'T'                                                     10522832
ER39G    DC    C'DATA DISPLAY'                                          10522833
ER40     DC    C'UNDEFINED'                                             10522834
ER41     DC    C'VARIABLE '                                             10522835
ER42A    DC    C'FIXED    '                                             10522836
ER42     DC    C'HEX '                                                  10522837
ER43     DC    C'FS  '                                                  10522838
ER44     DC    C'UNPK'                                                  10522839
ER45A    DC    C'TAPE MULTIPLE   '                                      10522840
ER46     DC    C'NO REWIND,UNLOAD'                                      10522841
ER47     DC    C'PRINT CHARACTER '                                      10522842
ER48     DC    C'PRINT HEX'                                             10522843
ER49     DC    C'TAPE REWIND'                                           10522844
ER50     DC    C'TAPE REWIND,UNLO'                                      10522845
         DC    C'AD'                                                    10522846
         DC    X'22'                                                    10522847
ERWR     DC    C'    CAN NOT PROC'                                      10522848
         DC    C'ESS PACK PARAMET'                                      10522849
         DC    C'ER'                                                    10522850
         ORG   STAR+3826                                                10522851
NOFS     DS    H                                                        10522852
         END   START                                                    10522853
         TITLE 'PHASE 3&4 TAPE TO PRINTER'                              10522854
         START 2752                                                     10522855
STRT     BALR  15,0                                                     10522856
         USING *,15                                                     10522857
         BC    15,INI3                                                  10522858
SORS     EQU   2500                                                     10522859
QORS     EQU   2504                                                     10522860
IRCLN    EQU   2508                                                     10522861
IBKSZ    EQU   2510                                                     10522862
ORCLN    EQU   2512                                                     10522863
OBKSZ    EQU   2514                                                     10522864
TPGM     EQU   2516                                                     10522865
TJOB     EQU   2517                                                     10522866
FRCD     EQU   2518                                                     10522867
DOPTN    EQU   2519                                                     10522868
POPTN    EQU   2520                                                     10522869
LABSW    EQU   2521                                                     10522870
ICU      EQU   2522                                                     10522871
OCU      EQU   2523                                                     10522872
IBKC     EQU   2524                                                     10522873
OBKC     EQU   2528                                                     10522874
LABIH    EQU   2532                                                     10522875
LABOH    EQU   2534                                                     10522876
LABIT    EQU   2536                                                     10522877
LABOT    EQU   2538                                                     10522878
LABOR    EQU   2540                                                     10522879
AAST     EQU   2542                                                     10522880
LABRTN   EQU   2544                                                     10522881
IPA      EQU   2546                                                     10522882
OPA      EQU   2548                                                     10522883
INA      EQU   2550                                                     10522884
INB      EQU   2552                                                     10522885
OUTA     EQU   2554                                                     10522886
OUTB     EQU   2556                                                     10522887
UCLIM    EQU   2558                                                     10522888
SWHD     EQU   2560                                                     10522889
NOIO     EQU   2561                                                     10522890
HEAD     EQU   2562                                                     10522891
DSTBL    EQU   2706                                                     10522892
*                                                                       10522893
****  ** PHASE IV,  TAPE TO PRINT PROGRAM **                            10522894
*                                                                       10522895
***   INPUT OPERATION                                                   10522896
*                                                                       10522897
         LA    15,2754                                                  10522898
         LM    1,10,REG                                                 10522899
OPEN     LA    7,P3IH+2                                                 10522900
         STH   7,LABRTN                                                 10522901
         STM   1,10,REG                                                 10522902
         LH    7,LABIH                                                  10522903
P3IH     BCR   15,7           BRANCH TO OPEN INPUT FILE                 10522904
         LM    1,10,REG                                                 10522905
         BC    15,AAA                                                   10522906
         LA    7,PH3IH+2                                                10522907
         STH   7,LABIH                                                  10522908
AAA      LH    11,OUTA        CLEAR OUTPUT AREA                         10522909
         LH    7,OBKSZ                                                  10522910
         BCTR  7,0                                                      10522911
         BCTR  7,0                                                      10522912
         MVI   0(11),X'40'                                              10522913
         STC   7,*+5                                                    10522914
         MVC   1(0,11),0(11)                                            10522915
         LH    11,OUTB                                                  10522916
         MVI   0(11),X'40'                                              10522917
         STC   7,*+5                                                    10522918
         MVC   1(0,11),0(11)                                            10522919
ISVC     DC    X'4700'                                                  10522920
         DC    YL2(CCBIA)                                               10522921
AA3      BC    0,AG3          IS INPUT AREA EXHAUSTED                   10522922
AB3      BC    0,AB2          IS 1-INPUT AREA                           10522923
         TM    2(1),X'80'     WAIT INPUT                                10522924
         BC    8,*-4                                                    10522925
RTN1     LH    7,IAREA                                                  10522926
         CLC   CHKPT(12),0(7) IS CHECK POINT                            10522927
         BC    8,TST4         YES, BRANCH TO TST4                       10522928
CH4      BC    0,CPT4+4                                                 10522929
         TM    3(1),X'04'     IS INPUT END OF FILE                      10522930
         BC    7,IEOV                                                   10522931
         NI    IEOV+1,X'0F'                                             10522932
         L     7,IBKC         COUNT THE NUMBER OF BLOCKS                10522933
         LA    7,1(7)                                                   10522934
         ST    7,IBKC                                                   10522935
         TM    2(1),X'40'     IS INCORRECT LENGTH                       10522936
         BC    8,AD4-4                                                  10522937
         OI    SWDP,X'04'     SET INCORRECT LENGTH                      10522938
         MVC   RSCNT(2),0(1)  SUPPLY RESIDUAL COUNT                     10522939
         TM    TJOB,X'10'     IS DATA DISPLAY                           10522940
         BC    1,AD4-4        YES, BRANCH TO AD4-4                      10522941
         TM    FRCD,X'01'     IS FIXED RECORD                           10522942
         BC    8,AD4-4        NO, BRANCH TO AD4-4                       10522943
         LA    11,RRLMG+35                                              10522944
         L     7,IBKC                                                   10522945
         CVD   7,DRCNO                                                  10522946
         OI    DRCNO+7,X'0F'                                            10522947
         UNPK  0(7,11),DRCNO(8)                                         10522948
         CLI   0(11),X'F0'                                              10522949
         BC    7,*+16                                                   10522950
         MVI   0(11),X'F0'                                              10522951
         LA    11,1(11)                                                 10522952
         BC    15,*-16                                                  10522953
         SVC   0              LOG MESSAGE                               10522954
         DC    YL2(CCBER)                                               10522955
         TM    CCBER+3,X'05'                                            10522956
         BC    8,*-4                                                    10522957
         BC    4,*+12         NON CHANNEL 12                            10522958
         MVI   ROE4-3,X'F0'                                             10522959
         MVI   ROE2-3,X'F0'                                             10522960
         OI    SWDP,X'01'     SET NEW BLOCK                             10522961
AD4      BC    15,CHGIM       CHANG INPUT LIST                          10522962
         MVC   ITAREA(2),INB                                            10522963
         MVC   IAREA(2),INA                                             10522964
         LA    1,CCBIA                                                  10522965
         STH   1,CHGI1                                                  10522966
         LH    6,INB                                                    10522967
         BC    15,CHGIX                                                 10522968
CHGIM    MVC   ITAREA(2),INA                                            10522969
         MVC   IAREA(2),INB                                             10522970
         LA    1,CCBIB                                                  10522971
         STH   1,CHGI1                                                  10522972
         LH    6,INA                                                    10522973
CHGIX    STH   6,INFD         SET INFD                                  10522974
         LR    5,6                                                      10522975
         AH    5,IBKSZ                                                  10522976
         BCTR  5,0                                                      10522977
         XI    AD4+1,X'F0'                                              10522978
         LH    4,IRCLN                                                  10522979
         SVC   0              EXECUTE INPUT                             10522980
CHGI1    DC    YL2(CCBIB)                                               10522981
         BC    15,AG3                                                   10522982
CPT4     STH   1,*+6          SKIP READING                              10522983
         SVC   0                                                        10522984
         DS    H                                                        10522985
         BC    15,AB3+4                                                 10522986
TST4     TM    CH4+1,X'F0'    IS FIRT CHKPT RECORD                      10522987
         BC    8,CPFT4        YES, BRANCH TO CPFT4                      10522988
         NI    CH4+1,X'0F'    SET BRANCH INSTRUCTION                    10522989
         BC    15,CPT4+4                                                10522990
CPFT4    OI    CH4+1,X'F0'    SET BRANCH INSTRUCTION                    10522991
         BC    15,CPT4                                                  10522992
TST2     TM    CH2+1,X'F0'    IS FIRST TIME                             10522993
         BC    8,CPFT2        YES, BRANCH TO CPFT2                      10522994
         NI    CH2+1,X'0F'    SET BRANCH INSTRUCTION                    10522995
         BC    15,AD1-4                                                 10522996
CPFT2    OI    CH2+1,X'F0'    SET BRANCH INSTRUCYION                    10522997
         BC    15,AD1-4                                                 10522998
AC2      NI    AB2+1,X'0F'                                              10522999
         BC    15,AD1                                                   10523000
AB2      BC    0,AC2                                                    10523001
         STH   1,*+6                                                    10523002
         SVC   0              EXECUTE INPUT                             10523003
         DC    YL2(CCBIA)                                               10523004
AD1      TM    2(1),X'80'     WAIT INPUT                                10523005
         BC    8,*-4                                                    10523006
RTN2     LH    7,IAREA        IS CHECK POINT RECOR                      10523007
         CLC   CHKPT(12),0(7)                                           10523008
         BC    8,TST2         YES, BRANCH TO TST2                       10523009
CH2      BC    0,AD1-4                                                  10523010
         TM    3(1),X'04'     IS INPUT END OF FILE                      10523011
         BC    7,IEOV                                                   10523012
         NI    IEOV+1,X'0F'                                             10523013
         L     7,IBKC         COUNT THE NUMBER OF BLOCKS                10523014
         LA    7,1(7)                                                   10523015
         ST    7,IBKC                                                   10523016
         TM    2(1),X'40'     IS INCORRECT LENGTH                       10523017
         BC    8,AF1-4                                                  10523018
         OI    SWDP,X'04'     SET INCORRECT LENGTH                      10523019
         MVC   RSCNT(2),0(1)  SUPPLY RESIDUAL COUNT                     10523020
         TM    TJOB,X'10'     IS DATA DISPLAY                           10523021
         BC    1,AF1-4        YES, BRANCH TO AF1-4                      10523022
         TM    FRCD,X'01'     IS FIXED RECORD                           10523023
         BC    8,AF1-4        NO, BRANCH TO AF1-4                       10523024
         LA    11,RRLMG+35                                              10523025
         L     7,IBKC                                                   10523026
         CVD   7,DRCNO                                                  10523027
         OI    DRCNO+7,X'0F'                                            10523028
         UNPK  0(7,11),DRCNO(8)                                         10523029
         CLI   0(11),X'F0'                                              10523030
         BC    7,*+16                                                   10523031
         MVI   0(11),X'F0'                                              10523032
         LA    11,1(11)                                                 10523033
         BC    15,*-16                                                  10523034
         SVC   0              LOG MESSAGE                               10523035
         DC    YL2(CCBER)                                               10523036
         TM    CCBER+3,X'05'                                            10523037
         BC    8,*-4                                                    10523038
         BC    4,*+12         NON CHANNEL 12                            10523039
         MVI   ROE4-3,X'F0'                                             10523040
         MVI   ROE2-3,X'F0'                                             10523041
         OI    SWDP,X'01'     SET NEW BLOCK                             10523042
AF1      BC    15,CHGM        CHANGE INPUT LIST                         10523043
         MVC   ITAREA(2),INB                                            10523044
         MVC   IAREA(2),INA                                             10523045
         LA    1,CCBIA                                                  10523046
         STH   1,CHGI2                                                  10523047
         BC    15,CHGX                                                  10523048
CHGM     MVC   ITAREA(2),INA                                            10523049
         MVC   IAREA(2),INB                                             10523050
         LA    1,CCBIB                                                  10523051
         STH   1,CHGI2                                                  10523052
CHGX     LH    6,INA                                                    10523053
         STH   6,INFD         SET INFD                                  10523054
         LR    5,6                                                      10523055
         AH    5,IBKSZ                                                  10523056
         BCTR  5,0                                                      10523057
         LH    4,IRCLN                                                  10523058
         XI    AF1+1,X'F0'                                              10523059
*                                                                       10523060
***   MAIN LINE                                                         10523061
*                                                                       10523062
**    DATA DISPLAY                                                      10523063
*                                                                       10523064
AG3      TM    TJOB,X'10'     IS DATA DISPLAY                           10523065
         BC    8,SHR          NO, BRANCH TO SHR                         10523066
DPLY     BC    15,NWPG        PRINT 1ST PRINTING LINE                   10523067
         LH    11,OTAREA      SET RG.11 WITH OTAREA                     10523068
         NI    BA3+1,X'0F'    SET OUTPUT AREA EXHAUSTED                 10523069
         TM    SWDP,X'01'     IS NEW BLOCK                              10523070
         BC    8,DSRCK        NO, BRANCH TO DSRCK                       10523071
         NI    SWDP,X'FC'     SET SWDP OFF                              10523072
         LH    7,BKNO         PROVIDE BLOCK NO                          10523073
         LA    7,1(7)                                                   10523074
         STH   7,BKNO                                                   10523075
         CVD   7,DRCNO                                                  10523076
         OI    DRCNO+7,X'0F'                                            10523077
         UNPK  8(6,11),DRCNO(8)                                         10523078
         CLI   8(11),X'F0'                                              10523079
         BC    7,*+16                                                   10523080
         MVI   8(11),X'40'                                              10523081
         LA    11,1(11)                                                 10523082
         BC    15,*-16                                                  10523083
         LH    11,OTAREA                                                10523084
         TM    SWDP,X'04'     IS WRONG LENGTH                           10523085
         BC    8,PRRCD        NO, BRANCH TO PRRCD                       10523086
         NI    SWDP,X'FB'     SET SWDP OFF                              10523087
         LH    7,IBKSZ        PROVIDE BLOCK SIZE                        10523088
         SH    7,RSCNT                                                  10523089
         SH    5,RSCNT                                                  10523090
         TM    FRCD,X'01'                                               10523091
         BC    1,*+6                                                    10523092
         LR    4,7                                                      10523093
         CVD   7,DRCNO                                                  10523094
         OI    DRCNO+7,X'0F'                                            10523095
         UNPK  0(8,11),DRCNO(8)                                         10523096
         CLI   0(11),X'F0'                                              10523097
         BC    7,*+16                                                   10523098
         MVI   0(11),X'40'                                              10523099
         LA    11,1(11)                                                 10523100
         BC    15,*-16                                                  10523101
         LH    11,OTAREA                                                10523102
PRRCD    LH    7,RCNO         PROVIDE RECORD NO                         10523103
         LA    7,1(7)                                                   10523104
         STH   7,RCNO                                                   10523105
         CH    7,SORS+2       SHOULD SKIP RECORDS                       10523106
         BC    10,NOTOBE      NO                                        10523107
         OI    BA3+1,X'F0'    SET OUTPUT AREA NON EXHAUSTED             10523108
         BC    15,TOBE                                                  10523109
NOTOBE   CVD   7,DRCNO                                                  10523110
         OI    DRCNO+7,X'0F'                                            10523111
         UNPK  14(5,11),DRCNO(8)                                        10523112
         CLI   14(11),X'F0'                                             10523113
         BC    7,*+16                                                   10523114
         MVI   14(11),X'40'                                             10523115
         LA    11,1(11)                                                 10523116
         BC    15,*-16                                                  10523117
         LH    11,OTAREA                                                10523118
DSST     LR    7,6            IS INFD+HNDRD SMALLER THAN INLRA+IRCLN    10523119
         AR    7,4                                                      10523120
         SH    7,HNDRD                                                  10523121
         CH    7,INFD                                                   10523122
         BC    2,DSWM         YES, BRANCH TO DSWM                       10523123
         NI    DSBC+1,X'0F'                                             10523124
         AH    7,HNDRD                                                  10523125
         SH    7,INFD                                                   10523126
HEXBC    BC    15,HEX         IS HEXADECIMAL                            10523127
         BCTR  7,0                                                      10523128
         STC   7,DSMVC+1                                                10523129
         LH    7,INFD                                                   10523130
DSMVC    MVC   20(0,11),0(7)                                            10523131
DSBC     BC    0,SOS                                                    10523132
TOBE     OI    SWDP,X'02'     SET NEW RECORD                            10523133
         BXLE  6,4,DSCHK      MODIFY RECORD ADDRESS                     10523134
         NI    AA3+1,X'0F'                                              10523135
         NI    BB3+1,X'0F'                                              10523136
         BC    15,DSED                                                  10523137
DSCHK    OI    AA3+1,X'F0'                                              10523138
         OI    BB3+1,X'F0'                                              10523139
DSED     STH   6,INFD         MODIFY INFD                               10523140
         BC    15,BA3                                                   10523141
DSRCK    TM    SWDP,X'02'     IS NEW RECORD                             10523142
         BC    8,DSST         NO, BRANCH TO DSST                        10523143
         BC    15,PRRCD       YES, BRANCH TO PRRCD                      10523144
HEX      LR    14,7           TRANSLATE INTO HEZADECIMAL                10523145
         MVI   DRCNO+7,X'0F'                                            10523146
         AR    7,7                                                      10523147
         BCTR  7,0                                                      10523148
         STC   7,DSTR+1                                                 10523149
         LH    7,INFD                                                   10523150
DSLP     SH    14,SVN         DOES FIELD REMAIN                         10523151
         BC    2,DSMVO        NO, BRANCH TO DSMVO                       10523152
         BC    8,DSHBC+4                                                10523153
         AH    14,SVN         YES, MODIFY FINAL UNPK                    10523154
         STC   14,DSUNPK+1                                              10523155
         BCTR  14,0                                                     10523156
         LA    14,112(14)                                               10523157
         STC   14,DSMVO+1                                               10523158
         IC    14,DSUNPK+1                                              10523159
         AR    14,14                                                    10523160
         BCTR  14,0                                                     10523161
         SLA   14,4                                                     10523162
         LA    14,7(14)                                                 10523163
         STC   14,DSUNPK+1                                              10523164
         NI    DSHBC+1,X'0F'                                            10523165
DSMVO    MVO   DRCNO(8),0(7,7)                                          10523166
DSUNPK   UNPK  20(14,11),DRCNO(8)                                       10523167
         LA    7,7(7)                                                   10523168
         LA    11,14(11)                                                10523169
DSHBC    BC    15,DSLP                                                  10523170
         OI    DSHBC+1,X'F0'                                            10523171
         MVI   DSMVO+1,X'76'                                            10523172
         MVI   DSUNPK+1,X'D7'                                           10523173
         LH    11,OTAREA                                                10523174
DSTR     TR    20(0,11),DSTBL-240                                       10523175
         LH    7,INFD                                                   10523176
         BC    15,DSMVC+6                                               10523177
DSWM     LH    7,HNDRD                                                  10523178
         OI    DSBC+1,X'F0'                                             10523179
         OI    AA3+1,X'F0'    SET INPUT NON EXHAUSTED                   10523180
         OI    BB3+1,X'F0'                                              10523181
         OI    DSBC+1,X'F0'                                             10523182
         BC    15,HEXBC                                                 10523183
SOS      AH    7,HNDRD        MODIFY INFD                               10523184
         STH   7,INFD                                                   10523185
         NI    SWDP,X'FD'     SET NEW RECORD OFF                        10523186
         BC    15,BA3                                                   10523187
*                                                                       10523188
***   SHIFT ROUTINE                                                     10523189
*                                                                       10523190
SHR      TM    SWDP,X'04'     IS WRONG LENGTH                           10523191
         BC    8,RTN3         NO, BRANCH TO RTN3                        10523192
         NI    SWDP,X'FB'     SET SWDP OFF                              10523193
         SH    5,RSCNT                                                  10523194
RTN3     LH    11,UCLIM       BRANCH TO PHASE II                        10523195
         BALR  7,11                                                     10523196
         BXLE  6,4,SSICHK     MODIFY INPUT LOGICAL RECORD ADDRESS       10523197
         NI    AA3+1,X'0F'                                              10523198
         NI    BB3+1,X'0F'                                              10523199
         BC    15,SSOCHK                                                10523200
SSICHK   OI    AA3+1,X'F0'                                              10523201
         OI    BB3+1,X'F0'                                              10523202
SSOCHK   LH    7,RCNO         CHECK SKIPPING RECORDS                    10523203
         LA    7,1(7)                                                   10523204
         STH   7,RCNO                                                   10523205
         CH    7,SORS+2       SHOULD SKIP RECORDS                       10523206
         BC    4,AA3          YES, SKIP RECORDS                         10523207
         BXLE  10,8,*+12      MODIFY OUTPUT LOGICAL RECORD ADDRESS      10523208
         NI    BA3+1,X'0F'                                              10523209
         BC    15,*+8                                                   10523210
         OI    BA3+1,X'F0'                                              10523211
*                                                                       10523212
***   AUXILIARY INPUT OPERATION                                         10523213
*                                                                       10523214
BA3      BC    15,AA3         IS OUTPUT AREA EXHAUSTED                  10523215
BB3      BC    0,BD3          IS INPUT AREA EXHAUSTED                   10523216
BB2      BC    0,BD3          IS 1-INPUT AREA                           10523217
         SVC   0              EXECUTE INPUT                             10523218
CHGI2    DC    YL2(CCBIB)                                               10523219
         OI    AB2+1,X'F0'                                              10523220
*                                                                       10523221
***   OUTPUT OPERATION                                                  10523222
*                                                                       10523223
BD3      BC    0,BD2          IS 1-OUTPUT AREA                          10523224
         BC    15,BH4                                                   10523225
         TM    3(2),X'05'     WAIT PRINT OUTPUT                         10523226
         BC    8,*-4                                                    10523227
         BC    1,OEOV                                                   10523228
ROE4     LH    11,OAREA       SET REG. 11 WITH  OAREA                   10523229
         LH    7,OBKSZ        CLEAR PRINTING AREA                       10523230
         BCTR  7,0                                                      10523231
         STC   7,*+5                                                    10523232
         XC    0(0,11),0(11)                                            10523233
BF4      BC    15,CHGOM       CHANG OUTPUT LIST                         10523234
         MVC   OTAREA(2),OUTA                                           10523235
         MVC   OAREA(2),OUTB                                            10523236
         LA    2,CCBOB                                                  10523237
         STH   2,CHGO1                                                  10523238
         LH    10,OUTA                                                  10523239
         BC    15,CHGOX                                                 10523240
CHGOM    MVC   OTAREA(2),OUTB                                           10523241
         MVC   OAREA(2),OUTA                                            10523242
         LA    2,CCBOA                                                  10523243
         STH   2,CHGO1                                                  10523244
         LH    10,OUTB                                                  10523245
CHGOX    XI    BF4+1,X'F0'                                              10523246
         LR    9,10                                                     10523247
         AH    9,OBKSZ                                                  10523248
         BCTR  9,0                                                      10523249
         SVC   0              EXECUTE OUTPUT                            10523250
CHGO1    DC    YL2(CCBOA)                                               10523251
         BC    15,AA3                                                   10523252
BH4      NI    BD3+5,X'0F'                                              10523253
         BC    15,BF4                                                   10523254
BD2      SVC   0              EXECUTE OUTPUT                            10523255
CHGO2    DC    YL2(CCBOA)                                               10523256
         TM    3(2),X'05'     WAIT PRINT OUTPUT                         10523257
         BC    8,*-4                                                    10523258
         BC    1,OEOV                                                   10523259
ROE2     LH    11,OTAREA      SET REG. 11 WITH OTAREA                   10523260
         LH    7,OBKSZ        CLEAR PRINTING AREA                       10523261
         BCTR  7,0                                                      10523262
         STC   7,*+5                                                    10523263
         XC    0(0,11),0(11)                                            10523264
BG2      BC    15,CHGMO       CHANGE OUTPUT LIST                        10523265
         MVC   OTAREA(2),OUTA                                           10523266
         LA    2,CCBOA                                                  10523267
         STH   2,CHGO2                                                  10523268
         BC    15,CHGXO                                                 10523269
CHGMO    MVC   OTAREA(2),OUTB                                           10523270
         LA    2,CCBOB                                                  10523271
         STH   2,CHGO2                                                  10523272
CHGXO    XI    BG2+1,X'F0'                                              10523273
         LH    10,OUTA                                                  10523274
         BC    15,AA3                                                   10523275
*                                                                       10523276
***   PRINT OUTPUT END OF PAGE ROUTINE                                  10523277
*                                                                       10523278
OEOV     TM    TJOB,X'10'     IS DATA DISPLAY                           10523279
         BC    1,PAGE         YES, BRANCH TO PAGE                       10523280
         TM    POPTN,X'01'    IS PAGE NO DEFINED                        10523281
         BC    1,PAGE         YES, BRANCH TO PAGE                       10523282
         SVC   0              SKIP TO CHANNEL 1                         10523283
         DC    YL2(CCBSK)                                               10523284
         TM    CCBSK+3,X'01'                                            10523285
         BC    8,*-4                                                    10523286
NWPG     TM    SWHD,X'FF'     IS HEADER LINE PROVIDED                   10523287
         BC    8,POE          NO, BRANCH TO POE                         10523288
         SVC   0              PRINT HEADER LINE                         10523289
         DC    YL2(CCBHD)                                               10523290
         TM    CCBHD+3,X'01'                                            10523291
         BC    8,*-4                                                    10523292
POE      TM    TJOB,X'10'     IS DATA DISPLAY                           10523293
         BC    8,EPOE         NO, BRANCH TO EPOE                        10523294
         MVC   SCLN+1(19),TTL                                           10523295
         MVC   CCWPG(1),CODE                                            10523296
         SVC   0                                                        10523297
         DC    YL2(CCBPG)                                               10523298
         TM    CCBPG+3,X'01'                                            10523299
         BC    8,*-4                                                    10523300
         MVI   CCWPG,X'89'                                              10523301
FTBC     BC    15,RST                                                   10523302
EPOE     TM    BD3+1,X'F0'    IS 1-OUTPUT AREA                          10523303
         MVI   ROE4-3,X'10'                                             10523304
         MVI   ROE2-3,X'10'                                             10523305
         BC    8,ROE4         NO, BRANCH TO ROE4                        10523306
         BC    15,ROE2        YES, BRANCH TO ROE2                       10523307
PAGE     MVC   SCLN+1(4),PG   SUPPLY PAGE AND NO                        10523308
         LH    7,PGNO                                                   10523309
         LA    7,1(7)                                                   10523310
         STH   7,PGNO                                                   10523311
         CVD   7,DRCNO                                                  10523312
         OI    DRCNO+7,X'0F'                                            10523313
         UNPK  SCLN+5(3),DRCNO(8)                                       10523314
         LA    7,SCLN+5                                                 10523315
         CLI   0(7),X'F0'                                               10523316
         BC    7,*+16                                                   10523317
         MVI   0(7),X'40'                                               10523318
         LA    7,1(7)                                                   10523319
         BC    15,*-16                                                  10523320
         SVC   0              PRINT PAGE AND SKIP TO CHANNEL 1          10523321
         DC    YL2(CCBPG)                                               10523322
         TM    CCBPG+3,X'01'                                            10523323
         BC    8,*-4                                                    10523324
         BC    15,NWPG                                                  10523325
RST      NI    FTBC+1,X'0F'                                             10523326
         NI    DPLY+1,X'0F'                                             10523327
         BC    15,DPLY+4                                                10523328
*                                                                       10523329
***   TAPE INPUT END OF FILE ROUTINE                                    10523330
*                                                                       10523331
IEOV     BC    15,ISVC                                                  10523332
         LA    7,P3IT+2                                                 10523333
         STH   7,LABRTN                                                 10523334
         STM   1,10,REG                                                 10523335
         LH    7,LABIT                                                  10523336
P3IT     BCR   15,7           BRANCH TO TRAILOR LABEL                   10523337
         LM    1,10,REG                                                 10523338
         TM    DOPTN,X'90'    IS UNLOAD OPTION                          10523339
         MVI   CCWIA,X'0F'    UNLOAD TAPE                               10523340
         BC    8,IERW         NO, BRANCH TO IERW                        10523341
         SVC   0                                                        10523342
         DC    YL2(CCBIA)                                               10523343
         TM    CCBIA+2,X'80'                                            10523344
         BC    8,*-4                                                    10523345
         MVI   CCWIA,X'02'                                              10523346
IERW     TM    DOPTN,X'40'    IS REWIND OPTION                          10523347
         BC    8,IEPS         NO, BRANCH TO IEPS                        10523348
         MVI   CCWIA,X'07'    REWIND TAPE                               10523349
         SVC   0                                                        10523350
         DC    YL2(CCBIA)                                               10523351
         TM    CCBIA+2,X'80'                                            10523352
         BC    8,*-4                                                    10523353
         MVI   CCWIA,X'02'                                              10523354
IEPS     TM    LABSW,X'10'    IS EOVOR EOF DEFINED                      10523355
         BC    1,TEOF         YES, BRANCH TO TEOF                       10523356
ANSWR    SVC   2              WAIT FOR OPERATOR                         10523357
         DC    CL6'3ANSA '                                              10523358
         CLI   ANSWR+7,C'Y'   IS EOF                                    10523359
         BC    8,B3           YES, BRANCH TO B3                         10523360
         CLI   ANSWR+7,C'N'   NO, EOV                                   10523361
         BC    7,ANSWR        NO, WAIT                                  10523362
         NI    LABSW,X'7F'    YES, SET LABSW                            10523363
TEOF     TM    LABSW,X'80'    IS EOF                                    10523364
         BC    1,B3           YES, BRANCH TO B3                         10523365
         SR    7,7            LOG END OF REEL FOR INPUT                 10523366
         IC    7,ICU                                                    10523367
         AH    7,22                                                     10523368
         MVO   FMVO(2),0(2,7)                                           10523369
         UNPK  EORMG+18(3),FMVO(2)                                      10523370
         SVC   0                                                        10523371
         DC    YL2(CCBEOR)                                              10523372
         TM    CCBEOR+3,X'01'                                           10523373
         BC    8,*-4                                                    10523374
FLBC     BC    15,*+12        SET CURRENT UNIT                          10523375
         IC    7,IPA                                                    10523376
         BC    15,*+8                                                   10523377
         IC    7,IPA+1                                                  10523378
         STC   7,ICU                                                    10523379
         STC   7,CCBIA+5                                                10523380
         STC   7,CCBIB+5                                                10523381
         XI    FLBC+1,X'F0'                                             10523382
         LA    7,PH3IH+2      SET LINKAGE                               10523383
         STH   7,LABRTN                                                 10523384
         STM   1,10,REG                                                 10523385
         LH    7,LABIH                                                  10523386
PH3IH    BCR   15,7           BRANCH TO OPEN INPUT                      10523387
         LM    1,10,REG                                                 10523388
         XC    IBKC(4),IBKC                                             10523389
         MVC   IEOV(4),EXIBC                                            10523390
EXI      STH   1,*+6                                                    10523391
         SVC   0              EXECUTE INPUT                             10523392
         DS    H                                                        10523393
         TM    2(1),X'80'                                               10523394
         BC    8,*-4                                                    10523395
         TM    AB3+1,X'F0'    IS 1-INPUT AREA                           10523396
       BC    1,RTN2                                                     10523397
         BC    15,RTN1        NO, BRANCH TO RTN1                        10523398
EXIBC    BC    15,EXI                                                   10523399
B3       TM    BA3+1,X'F0'    IS OUTPUT AREA EXHAUSTED                  10523400
         BC    8,IEMG         YES, BRANCH TO IEMG                       10523401
         SH    10,OTAREA      NO, COUNT BLOCK SIZE                      10523402
         STH   10,CCWOA+6     STORE COUNT AT COMMAND WORDS              10523403
         STH   10,CCWOB+6                                               10523404
         LA    3,IEWT         GENERATE LINKAGE TO OUTPUT OPERATION      10523405
         LH    7,BCR                                                    10523406
         STH   7,CHGO1+2                                                10523407
         STH   7,CHGO2+2                                                10523408
         BC    15,BD3                                                   10523409
BCR      BCR   15,3                                                     10523410
IEWT     TM    2(2),X'80'     WAIT OUTPUT                               10523411
         BC    8,*-4                                                    10523412
IEMG     SVC   0              LOG MESSAGE                               10523413
         DC    YL2(CCBLG3)                                              10523414
         TM    CCBLG3+3,X'01'                                           10523415
         BC    8,*-4                                                    10523416
         TM    POPTN,X'01'    IS PAGE REQUIRED                          10523417
         BC    1,*+12         YES, SKIP                                 10523418
         TM    TJOB,X'10'     IS DATA DISPLEY                           10523419
         BC    8,LST          NO, SKIP                                  10523420
         LH    7,BCR          GENERATE LINKAGE TO PAGE PRINT            10523421
         STH   7,RST-4                                                  10523422
         LA    3,LST                                                    10523423
         BC    15,PAGE                                                  10523424
LST      SVC   0              MESSAGE TERMINATION                       10523425
         DC    YL2(CCBLG1)                                              10523426
         TM    CCBLG1+3,X'01'                                           10523427
         BC    8,*-4                                                    10523428
         SVC   1              TERMINATE JOB                             10523429
         DC    CL6'SYSEOJ'                                              10523430
*                                                                       10523431
***   CONSTANT                                                          10523432
*                                                                       10523433
AK3      EQU   BA3                                                      10523434
         CNOP  0,8                                                      10523435
REG      DS    CL40                                                     10523436
DRCNO    DC    X'0000000000000000'                                      10523437
CCBIA    DC    X'00000000'                                              10523438
         DC    X'000C'                                                  10523439
         DC    YL2(CCWIA)                                               10523440
CCBIB    DC    X'00000000'                                              10523441
         DC    X'000C'                                                  10523442
         DC    YL2(CCWIB)                                               10523443
CCBOA    DC    X'00000400'                                              10523444
         DC    X'0010'                                                  10523445
         DC    YL2(CCWOA)                                               10523446
CCBOB    DC    X'00000400'                                              10523447
         DC    X'0010'                                                  10523448
         DC    YL2(CCWOB)                                               10523449
CCBSK    DC    X'00000400'                                              10523450
         DC    X'0010'                                                  10523451
         DC    YL2(CCWSK)                                               10523452
CCBHD    DC    X'000004000010'                                          10523453
         DC    YL2(CCWHD)                                               10523454
CCBPG    DC    X'00000400'                                              10523455
         DC    X'0010'                                                  10523456
         DC    YL2(CCWPG)                                               10523457
CCBLG1   DC    X'000004000014'                                          10523458
         DC    YL2(CCWLG1)                                              10523459
CCBLG3   DC    X'000004000010'                                          10523460
         DC    YL2(CCWLG3)                                              10523461
CCBER    DC    X'000004000014'                                          10523462
         DC    YL2(CCWER)                                               10523463
CCBEOR   DC    X'000004000014'                                          10523464
         DC    YL2(CCWEOR)                                              10523465
CCWIA    DC    X'0200000000000000'                                      10523466
CCWIB    DC    X'0200000000000000'                                      10523467
CCWOA    DC    X'0900000000000000'                                      10523468
CCWOB    DC    X'0900000000000000'                                      10523469
CCWSK    DC    X'8B00'                                                  10523470
         DC    YL2(BKNO)                                                10523471
         DC    X'00000001'                                              10523472
CCWHD    DC    X'09'                                                    10523473
         DC    AL3(HEAD)                                                10523474
         DC    X'00000090'                                              10523475
CCWPG    DC    X'89'                                                    10523476
         DC    AL3(SCLN)                                                10523477
         DC    X'00000078'                                              10523478
CCWLG1   DC    X'09'                                                    10523479
         DC    AL3(TMMG)                                                10523480
         DC    X'0000000B'                                              10523481
CCWLG3   DC    X'E1'                                                    10523482
         DC    AL3(MG3)                                                 10523483
         DC    X'0000000C'                                              10523484
CCWER    DC    X'09'                                                    10523485
         DC    AL3(RRLMG)                                               10523486
         DC    X'0000002A'                                              10523487
CCWEOR   DC    X'09'                                                    10523488
         DC    AL3(EORMG)                                               10523489
         DC    X'00000015'                                              10523490
INFD     DS    H                                                        10523491
ITAREA   DS    H                                                        10523492
OTAREA   DS    H                                                        10523493
IAREA    DS    H                                                        10523494
OAREA    DS    H                                                        10523495
PGNO     DC    X'0000'                                                  10523496
RSCNT    DS    H                                                        10523497
BKNO     DC    X'0000'                                                  10523498
RCNO     DC    X'0000'                                                  10523499
HNDRD    DC    X'0032'                                                  10523500
SVN      DC    X'0007'                                                  10523501
FMVO     DC    X'000F'                                                  10523502
TMMG     DC    C' END OF JOB'                                           10523503
MG3      DC    C' END OF DATA'                                          10523504
RRLMG    DC    C' INCORRECT BLOCK'                                      10523505
         DC    C' LENGTH AT BLK. '                                      10523506
         DC    C'NO.       '                                            10523507
EORMG    DC    C' END OF TAPE REE'                                      10523508
         DC    C'L    '                                                 10523509
SWDP     DC    X'03'                                                    10523510
PG       DC    C'PAGE'                                                  10523511
TTL      DC    C'BL SZ  BL NO  RC'                                      10523512
         DC    C' NO'                                                   10523513
SCLN     DC    C'                '                                      10523514
         DC    C'    ....5....1..'                                      10523515
         DC    C'..5....2....5...'                                      10523516
         DC    C'.3....5....4....'                                      10523517
         DC    C'5....5....5....6'                                      10523518
         DC    C'....5....7....5.'                                      10523519
         DC    C'...8....5....9..'                                      10523520
         DC    C'..5.....'                                              10523521
CODE     DC    X'09'                                                    10523522
CHKPT    DC    C'/// CHKPT //'                                          10523523
LAST     DS    H                                                        10523524
         ORG   LAST+132                                                 10523525
LAB3     MVC   CCBI+5(1),LICU                                           10523526
         MVI   CCWI,X'02'                                               10523527
         BAL   14,PER                                                   10523528
         TM    CCBI+3,X'04'                                             10523529
         BC    1,NN                                                     10523530
         CLC   LABEL(4),EOV1                                            10523531
         BC    8,R1                                                     10523532
         CLC   LABEL(4),EOF1                                            10523533
         BC    8,R2                                                     10523534
NN       TM    SWTIME,X'FF'                                             10523535
         BC    1,BN6                                                    10523536
         TM    CCBI+3,X'04'                                             10523537
         BC    1,RAT                                                    10523538
         TM    USW,X'40'                                                10523539
         BC    1,BN7                                                    10523540
         BC    15,LAB3                                                  10523541
BN7      LA    14,LAB3                                                  10523542
         STH   14,URET                                                  10523543
         LH    14,ULAB2                                                 10523544
         BCR   15,14                                                    10523545
BN6      NI    LABSW,X'EF'                                              10523546
         SVC   0                                                        10523547
         DC    YL2(CCBP)                                                10523548
         TM    CCBP+2,X'80'                                             10523549
         BC    8,*-4                                                    10523550
RAT      MVI   SWTIME,X'FF'                                             10523551
         OI    USW,X'40'                                                10523552
         LH    5,LLABRT                                                 10523553
         BCR   15,5                                                     10523554
         CNOP  0,8                                                      10523555
CCBP     DC    F'0'                                                     10523556
         DC    X'0014'                                                  10523557
         DC    YL2(CCWP)                                                10523558
CCWP     DC    X'09'                                                    10523559
         DC    AL3(PM)                                                  10523560
         DC    X'0000'                                                  10523561
         DC    X'000D'                                                  10523562
PM       DC    C'NO EOV OR EOF'                                         10523563
R1       OI    LABSW,X'10'                   PUT 1 IN 4 BIT             10523564
         NI    LABSW,X'7F'                   PUT 0 IN 1 BIT             10523565
CONT     PACK  FILPAC(8),LABEL+54(6)                                    10523566
         CVB   5,FILPAC                                                 10523567
         MVI   SWTIME,X'00'                                             10523568
         C     5,LIBKC                                                  10523569
         BC    7,MES9                                                   10523570
         BC    15,LAB3                                                  10523571
R2       OI    LABSW,X'90'                   PUT 1 S IN BITS 4 AND 1    10523572
         BC    15,CONT                                                  10523573
MES9     SVC   2                                                        10523574
       DC    C'3IBCA '                                                  10523575
         BC    15,LAB3                                                  10523576
BN3      TM    USW,X'80'                                                10523577
         BC    1,BN4                                                    10523578
         BC    15,LREAD2                                                10523579
BN4      LA    14,LREAD2                                                10523580
         STH   14,URET                                                  10523581
         LH    14,ULAB1                                                 10523582
         BCR   15,14                                                    10523583
PER      SVC   0                                                        10523584
         DC    YL2(CCBI)                                                10523585
         TM    CCBI+2,X'80'                                             10523586
         BC    8,*-4                                                    10523587
         BCR   15,14                                                    10523588
EOV1     DC    C'EOV1'                                                  10523589
EOF1     DC    C'EOF1'                                                  10523590
SWTIME   DC    X'FF'                                                    10523591
         CNOP  0,8                                                      10523592
CCBI     DC    F'0'                                                     10523593
         DC    X'0000'                                                  10523594
       DC    YL2(CCWI7)                                                 10523595
CCWI7  CCW   X'3F',LABEL,X'40',01                                       10523596
CCWI     DC    X'00'                                                    10523597
         DC    AL3(LABEL)                                               10523598
         DC    X'0000'                                                  10523599
         DC    X'0050'                                                  10523600
LABEL    DS    20F                                                      10523601
SW3      DC    X'00'                                                    10523602
         CNOP  0,8                                                      10523603
FILPAC   DC    D'0'                                                     10523604
SAVE8    DC    F'0'                                                     10523605
VOL1     DC    C'VOL1'                                                  10523606
UIN      DC    C'UIN'                                                   10523607
*                                                                       10523608
*                                                                       10523609
HDR1     DC    C'HDR1'                                                  10523610
*                                                                       10523611
LAB1     MVC   CCBI+5(1),LICU           GET INPUT CURRENT UNIT          10523612
       LH    14,22                                                      10523613
       AH    14,CCBI+4                                                  10523614
         MVI   CCWI7,X'3F'                                              10523615
         OC    CCWI7(1),3(14)                                           10523616
         XI    CCWI7,X'14'                                              10523617
LSAVE    L     8,SAVE8                  LOAD VOL SEQ NO IN REG 8        10523618
         LH    1,LAAST                                                  10523619
LREW1    MVI   CCWI,X'07'                                               10523620
         BAL   14,PER                   REWIND TAPE                     10523621
         MVI   CCWI,X'02'                                               10523622
         BAL   14,PER                   READ TAPE  VOL1                 10523623
         CLC   LABEL(4),VOL1            MATCH VOL1                      10523624
         BC    7,LREW2                                                  10523625
         TM    SW3,X'FF'                1ST REEL                        10523626
         BC    1,LREAD1                 BRANCH IF ON SECOND REEL        10523627
         CLC   1(3,1),UIN               MATCH VOL SERIAL NO T/C  GET CA 10523628
         BC    7,ABART                                                  10523629
         CLC   25(6,1),LABEL+4                                          10523630
         BC    7,LMES1                  BRANCH UNEQUAL                  10523631
LREAD1   MVI   CCWI,X'02'                                               10523632
         BAL   14,PER                   READ TAPE VOL                   10523633
         CLC   LABEL(3),VOL1            MATCH VOL                       10523634
         BC    8,LREAD1                 BRANC EQUAL TO READ             10523635
         CLC   LABEL(4),HDR1            MATCH HDR1                      10523636
         BC    7,LLREW2                                                 10523637
         TM    SW3,X'FF'                1ST REEL                        10523638
         BC    1,LMOVE                  BRANCH IF NO 1ST REEL           10523639
         CLC   LABEL+4(49),8(1)         FILE LABEL CHECK                10523640
         BC    7,LMES2                  BRANCH UNEQUAL                  10523641
LSTARE   PACK  FILPAC(8),LABEL+27(4)                                    10523642
         CVB   8,FILPAC                 VOL SEQ NO TO REG 8             10523643
LREAD2   MVI   CCWI,X'02'                                               10523644
         BAL   14,PER                   READ TAPE  UNTIL TAPE MARK      10523645
         TM    CCBI+3,X'04'                                             10523646
         BC    1,LEND                                                   10523647
         CLC   LABEL(3),HDR1                                            10523648
         BC    8,LREAD2                                                 10523649
         BC    15,BN3                                                   10523650
LLREW2   SVC   2                                                        10523651
       DC    C'3IHDA '                                                  10523652
         BC    15,LREW1                                                 10523653
LEND     MVI   SW3,X'FF'                SET ON SW3 1ST REEL             10523654
         ST    8,SAVE8                  STORE VOL SEQ NO COUNTER        10523655
         OI    USW,X'80'                                                10523656
         LH    5,LLABRT                 GET THE ADDRESS RETURN          10523657
         BCR   15,5                     BRANCH TO PH 4                  10523658
LREW2    MVI   CCWI,X'0F'                                               10523659
         BAL   14,PER                   REWIND UNLOAD                   10523660
         SVC   2                                                        10523661
       DC    C'3ISLA '                                                  10523662
         BC    15,LREW1                                                 10523663
LMES1    SVC   2                                                        10523664
       DC    C'3IVSA '                                                  10523665
         CLI   LMES1+7,C'R'                                             10523666
         BC    8,LREW1                                                  10523667
         BC    7,LREAD1                                                 10523668
LMOVE    MVC   31(4,1),LABEL+27                                         10523669
         CLC   LABEL+4(49),8(1)         FILE  LABEL C HECK ROUTINE      10523670
         BC    7,LMES3                                                  10523671
LSTORE   PACK  FILPAC(8),LABEL+27(4)                                    10523672
         CVB   7,FILPAC                                                 10523673
         LA    8,1(8)                   ADD ONE  REG8                   10523674
         CLR   7,8                                                      10523675
         BC    8,LREAD2                                                 10523676
         BC    7,LMES4                                                  10523677
LMES2    SVC   2                                                        10523678
       DC    C'3ICHA '                                                  10523679
         CLI   LMES2+7,C'R'                                             10523680
         BC    8,LREW1                                                  10523681
         BC    7,LSTARE                                                 10523682
LMES3    SVC   2                                                        10523683
       DC    C'3ICHA '                                                  10523684
         CLI   LMES3+7,C'R'                                             10523685
         BC    8,LREW1                                                  10523686
         BC    7,LSTORE                                                 10523687
LMES4    SVC   2                                                        10523688
       DC    C'3ISQA '                                                  10523689
         CLI   LMES4+7,C'R'                                             10523690
         BC    8,LSAVE                                                  10523691
         BC    7,LREAD2                                                 10523692
ABART  SVC   2                                                          10523693
       DC    C'3LCM  '                                                  10523694
       SVC   1                                                          10523695
         DC    C'SYSEOJ'                                                10523696
INI3     LA    1,LREAD2                                                 10523697
         STH   1,ULAB1                                                  10523698
         LA    1,LAB3             INPUT                                 10523699
         STH   1,ULAB2                                                  10523700
         LA    1,LABEL                                                  10523701
         STH   1,ULAB                                                   10523702
         TM    LABSW,X'20'                                              10523703
         BC    8,LOAD                                                   10523704
         LA    1,LAB1                                                   10523705
         STH   1,LLABIH                                                 10523706
         LA    1,LAB3                                                   10523707
         STH   1,LLABIT                                                 10523708
LOAD     BC    15,STAT                                                  10523709
*                                                                       10523710
LLABRT   EQU   2544                                                     10523711
LAAST    EQU   2542                                                     10523712
LIBKC    EQU   2524                                                     10523713
LICU     EQU   2522                                                     10523714
LLABIT   EQU   2536                                                     10523715
LLABIH   EQU   2532                                                     10523716
ULAB     EQU   2732                                                     10523717
URET     EQU   2730                                                     10523718
ULAB4    EQU   2728                                                     10523719
ULAB3    EQU   2726                                                     10523720
ULAB2    EQU   2724                                                     10523721
ULAB1    EQU   2722                                                     10523722
USW      EQU   2734                                                     10523723
*                                                                       10523724
***   INITIALIZATION                                                    10523725
*                                                                       10523726
STAT     TM    POPTN,X'40'    IS TRIPLE SPACE                           10523727
         BC    8,INTT         NO, BRANCH TO INTT                        10523728
         MVI   CCWOA,X'19'    YES, MODIFY COMMAND CODES                 10523729
         MVI   CCWOB,X'19'                                              10523730
         MVI   CCWHD,X'19'                                              10523731
         MVI   CCWER,X'19'                                              10523732
         MVI   CODE,X'19'                                               10523733
         BC    15,INT                                                   10523734
INTT     TM    POPTN,X'20'    IS DOUBLE SPACE                           10523735
         BC    8,INT          NO, BRANCH TO INT                         10523736
         MVI   CCWOA,X'11'    YES, MODIFY COMMAND CODES                 10523737
         MVI   CCWOB,X'11'                                              10523738
         MVI   CCWHD,X'11'                                              10523739
         MVI   CCWER,X'11'                                              10523740
         MVI   CODE,X'11'                                               10523741
INT      LH    1,IBKSZ        STORE COUNT AT COMMAND WORDS              10523742
         STH   1,CCWIA+6                                                10523743
         STH   1,CCWIB+6                                                10523744
         LH    1,OBKSZ                                                  10523745
         STH   1,CCWOA+6                                                10523746
         STH   1,CCWOB+6                                                10523747
         MVC   CCWIA+2(2),INA STORE STARTING ADDRESS AT COMMAND WORDS   10523748
         MVC   CCWIB+2(2),INB                                           10523749
         MVC   CCWOA+2(2),OUTA                                          10523750
         MVC   CCWOB+2(2),OUTB                                          10523751
         LA    1,CCBIA        SET INPUT CCB FOR AREA A                  10523752
         LA    2,CCBOA        SET OUTPUT CCB FOR AREA A                 10523753
         LH    4,IRCLN        SET REGISTER 4,5,6                        10523754
         LH    5,INA                                                    10523755
         STH   5,INFD                                                   10523756
         STH   5,ITAREA                                                 10523757
         STH   5,IAREA                                                  10523758
         LR    6,5                                                      10523759
         AH    5,IBKSZ                                                  10523760
         BCTR  5,0                                                      10523761
         LH    8,ORCLN        SET REGISTER 8,9,10                       10523762
         LH    9,OUTA                                                   10523763
         STH   9,OTAREA                                                 10523764
         LR    10,9                                                     10523765
         AH    9,OBKSZ                                                  10523766
         BCTR  9,0                                                      10523767
         SVC   0              SKIP TO CHANNEL 1                         10523768
         DC    YL2(CCBSK)                                               10523769
         TM    CCBSK+3,X'01'                                            10523770
         BC    8,*-4                                                    10523771
         TM    SWHD,X'FF'     IS HEADER LINE                            10523772
         BC    8,PT1          NO, BRANCH                                10523773
         TM    TJOB,X'10'     IS DATA DISPLAY                           10523774
         BC    1,PT1          YES, BRANCH                               10523775
         SVC   0              PRINT HEADER LINE                         10523776
         DC    YL2(CCBHD)                                               10523777
         TM    CCBHD+3,X'01'                                            10523778
         BC    8,*-4                                                    10523779
PT1      TM    DOPTN,X'04'    IS HEXADECIMAL                            10523780
         BC    1,TDD          YES, SKIP INSTRUCTIONS                    10523781
         LH    7,HNDRD        NO, MODIFY HNDRD                          10523782
         AR    7,7                                                      10523783
         STH   7,HNDRD                                                  10523784
         NI    HEXBC+1,X'0F'                                            10523785
TDD      TM    TJOB,X'10'     IS LIST OR FIELD SELECT                   10523786
         BC    1,INLAB        NO, BRANCH TO INLAB                       10523787
         XC    SCLN(132),SCLN ERASE SCALE LINE                          10523788
INLAB    CLI   LABIH,C'*'     IS INPUT LABEL DEFINED                    10523789
         BC    7,*+24         YES, SKIP                                 10523790
         LA    7,P3IH+2       NO, PROVIDE ADDRESSES                     10523791
         STH   7,LABIH                                                  10523792
         LA    7,P3IT+2                                                 10523793
         STH   7,LABIT                                                  10523794
         NI    P3IH+7,X'0F'                                             10523795
         MVC   ICU(1),IPA     SET CURRENT UNIT                          10523796
*                                                                       10523797
***   SETTING SWITCH ROUTINE                                            10523798
*                                                                       10523799
IOSC11   TM    NOIO,X'11'     ARE 1-INPUT 1-OUTPUT AREAS                10523800
         BC    12,IOSC12      NO, BRANCH TO IOSC12                      10523801
         OI    AB3+1,X'F0'                                              10523802
         OI    BD3+1,X'F0'                                              10523803
         NI    BB2+1,X'0F'                                              10523804
         BC    15,DAME                                                  10523805
IOSC12   TM    NOIO,X'12'     ARE 1-INPUT 2-OUTPUT AREAS                10523806
         BC    12,IOSC21      NO, BRANCH TO IOSC21                      10523807
         OI    AB3+1,X'F0'                                              10523808
         NI    BB2+1,X'0F'                                              10523809
         NI    BD3+1,X'0F'                                              10523810
         BC    15,DAME                                                  10523811
IOSC21   MVI   ISVC,X'0A'                                               10523812
         NI    AB3+1,X'0F'                                              10523813
         OI    BB2+1,X'F0'                                              10523814
         TM    NOIO,X'21'     ARE 2-INPUT 1-OUTPUT AREAS                10523815
         BC    12,IOSC22      NO, BRANCH TO IOSC22                      10523816
         OI    BD3+1,X'F0'                                              10523817
         BC    15,DAME                                                  10523818
IOSC22   NI    BD3+1,X'0F'                                              10523819
DAME     STM   1,10,REG                                                 10523820
         SVC   1                                                        10523821
         END   STRT                                                     10523822
