         TITLE 'SUPERVISOR'                                             10500001
SYSS00   START 0                                                        10500002
         USING *,0,4                                                    10500003
         ORG   SYSS00+5                                                 10500004
         DC    C' '                                                     10500005
         ORG   SYSS00+88                                                10500006
         DC    X'00040000'              NEW  EXT SIGNAL PSW             10500007
         DC    A(SYSEXT)                                                10500008
         DC    X'00040000'              NEW  SVC INTRT  PSW             10500009
         DC    A(SYSSVC)                                                10500010
         DC    X'00040000'              NEW  PROG CHECK PSW             10500011
         DC    A(SYSSPC)                                                10500012
         DC    X'00060000'              NEW  MACH CHECK PSW             10500013
SYSSMD         DC   X'F0FFFFFF'                                         10500014
         DC    X'00040000'              NEW  IO INTERPT PSW             10500015
         DC    A(SYSXIN)                                                10500016
         DC    YL2(SYSSCR)                                              10500017
         DC    YL2(SYSUTB)                                              10500018
       ORG   SYSS00+144                 DIAGNOSTICS USE 8 BYTES  START  10500019
SYSSLB     DC    X'FF0500000F'                                          10500020
         DC    AL3(SYSLDR)             USE ABSOLUTE LOADER              10500021
SYSS83   DS    D                       TO SAVE PSW BEFORE TIMER RTN     10500022
SYSS86   DS    D                                                        10500023
SYSS81   LM    10,11,SYSS86                                             10500024
         LPSW  SYSS83                  RETURN FROM TIMER RTN            10500025
SYSS84   DS    D                       TO SAVE PSW BEFORE OP.COM RTN    10500026
SYSS87   DS    D                                                        10500027
SYSS03   DC    X'09000000'              CCW WRITE MSG                   10500028
         DC    F'5'                                                     10500029
SYSS04   DC    X'0A000005'              CCW READ  REPLY                 10500030
         DC    F'1'                                                     10500031
SYSZVE   DS    F                       TO SAVE REG 10 FOR MSG HANDLING  10500032
SYSSAC   DS    F                       TO SAVE  REPLY ADDRESS           10500033
SYSSCB   DC    X'1000'                 DUMMY CCB FOR SVC 2 FORCE RTRN   10500034
SYSS93   MVC   24(8),32                                                 10500035
         B     SYSS13                                                   10500036
SYSTWA   DC    X'001F'                 TW ADDRESS                       10500037
SYSSVC   L     12,36                    LOAD ADD IN R12                 10500038
       CLI   35,X'01'       IS V SVC 1                                  10500039
         BL    SYSXCP                   GO TO IOCS (CODE 0)             10500040
         BE    SYSS11                   GO TO FETCH ROUTINE (CODE 1)    10500041
       CLI   35,X'03'       IS V SVC 3                                  10500042
         BNL   SYSS80                                                   10500043
SYSS06   MVC   0(5),0(12)               CODE 2    MESSAGE               10500044
         LA    12,6(12)                 CALCULATE NEXT INSTRUCTION ADDR 10500045
         IC    13,36                   STORE ADDRESS IN PSW             10500046
         ST    12,36                                                    10500047
         STC   13,36                                                    10500048
         BCTR  12,0                    CALCULATE EDDRESS FOR REPLY      10500049
         MVI   SYSS03+4,X'20'          SUPPRESS CHAINING IN CCW         10500050
         CLI   4,C'A'                   IF A  REPLY                     10500051
         BNE   *+8                      IS WANTED PUT CHAINING BIT      10500052
         MVI   SYSS03+4,X'60'                                           10500053
         ST    12,SYSSAC               SAVE ADDRESS FOR REPLY           10500054
         MVC   58(2),SYSTWA            LOAD CH,UNIT ADDRESS             10500055
       LA    12,SYSMSG-SYSQMX                                           10500056
       ST    10,SYSZVE                                                  10500057
         BAL   10,SYSQXS               USE ROUTINE TO SET UP CCW AND T5 10500058
         DC    YL2(SYSS03)             CCW ADDRESS                      10500059
       L     10,SYSZVE                                                  10500060
         TM    SYSSCB,X'20'                                             10500061
         BC    8,SYSS93                 NOT DISASTER,CONTINUE           10500062
SYSS09   OI    32,X'01'                 UNMASK EXT IN                   10500063
         OI    33,X'02'                 AND ENTER WAIT STATE            10500064
SYSXST LPSW  32                         RETURN TO MAIN LINE   SVC       10500065
SYSS82   LM    10,11,SYSS87                                             10500066
         NI    SYSSOC+1,X'0F'          ACCEPT NEXT ATTENTION ON 1052    10500067
         LPSW  SYSS84                  RETURN FROM OP.COM. RTN          10500068
SYSS80   CLI   35,X'04'                                                 10500069
         BE    SYSS82                  CODE 3  RETURN FROM OP.COM RTN   10500070
         BL    SYSS81                  CODE 3  RETURN FROM TIMER RTN    10500071
SYSS10   MVI   35,X'10'                 SVC CODE ERROR                  10500072
         MVC   40(8),32                 SIMULATE PROG CHECK             10500073
         B     SYSSPC                   WITH INTRT CODE 00010000        10500074
SYSS11   CLC   0(6,12),SYSSLC           COMPARE NAME WITH EOJ           10500075
SYSSAT   MVC   32(8),SYSSLB             MOVE  PROB PSW                  10500076
         BNE   SYSS09+8                 LOAD PSW                        10500077
         B     SYSS09+4                 LOAD PSW WITH WAIT STATE        10500078
SYSEXT   TM    27,X'80'                IS IT TIMER INTERRUPT            10500079
         BO    SYSSTM                  GO TO HANDLING OF TIMER INTERRUP 10500080
SYSS13   CLI   4,C'A'                   IF REPLY NOT REQUIRED           10500081
         MVI   4,C' '                                                   10500082
         BNE   SYSS15                   IGNORE THIS MSG                 10500083
         L     12,SYSSAC                                                10500084
         MVC   0(1,12),5                MOVE REPLY IN CALLING SEQUENCE  10500085
         CLI   5,C' '                                                   10500086
         BE    SYSS15                   IGNORE CODE IF BLANK            10500087
         NI    5,X'FC'                 IS CODE 0 TO 4 IN BINARY         10500088
         CLI   5,X'F0'                  OR CHARACTER FORM               10500089
         BE    SYSS17                                                   10500090
SYSS14   CLI   5,X'02'                  IF CODE 0 OR 1                  10500091
         BL    SYSS18                   GO TO ABNORMAL END OF JOB       10500092
         CLI   5,X'03'                                                  10500093
         BE    SYSS99                                                   10500094
         BL    SYSS19                   GO TO -SET 7TH BIT ON IN UPSI - 10500095
SYSS15   MVI   5,C' '                   IGNORE OR END OF MSG-REPLY      10500096
         NI    25,X'FD'                 PROCESSING                      10500097
SYSS16   LPSW  24                                                       10500098
SYSS99   NI    SYSUPS,X'FE'                                             10500099
         B     SYSS15                                                   10500100
SYSS17 MVC   5(1),0(12)                                                 10500101
         NI    5,X'0F'                           INTO BINARY FORM       10500102
         B     SYSS14                                                   10500103
SYSS19   OI    SYSUPS,X'01'            SET ON 8TH BIT OF UPSI           10500104
         B     SYSS15                                                   10500105
SYSS20   DC    H'1'                                                     10500106
SYSSTM   MVC   SYSS83(8),24            SAVE OLD PSW                     10500107
         STM   10,11,SYSS86                                             10500108
         LH    12,SYSRTA+2             IS AN USER(S RTN PROVIDED        10500109
         LTR   12,12                                                    10500110
         BZ    SYSS81                  NO - RETURN                      10500111
         STH   12,30                   YES - GO TO THIS ROUTINE         10500112
         LPSW  24                                                       10500113
SYSSOC   BC    0,SYSSCX                ACCEPT OR NOT ATTENTION ON 1052  10500114
         MVC   SYSS84(8),56            SAVE OLD PSW                     10500115
         STM   10,11,SYSS87                                             10500116
         SVC   2                       MACRO TO ASK FOR THE CODE        10500117
         DC    C'0902A '                                                10500118
         LH    12,SYSRTA+4             IS AN USER,S RTN PROVIDED        10500119
         LTR   12,12                                                    10500120
         BZ    SYSS82                  NO - RETURN                      10500121
         STH   12,62                   YES - GO TO THIS ROUTINE         10500122
         OI    SYSSOC+1,X'F0'          1052 ATTENTION NOT ACCEPTED      10500123
SYSSCX   LPSW  56                                                       10500124
         DS    0F                                                       10500125
SYSS21   DC    X'0000FFFF'              MASK FOR LOAD HALFWORD          10500126
SYSSCR   DC    F'0'                    COMMUNICATION REGION- MONTH-DAY  10500127
         DC    H'0'                                           YEAR      10500128
         DC    X'000000'                                      DATE      10500129
         DC    X'00'                                          CONFIG    10500130
SYSEND   DC    YL2(SYSSND)             END OF SUPERVISOR                10500131
SYSUSR   DC    2F'0'                   FOR USER - RESET BY SYSEOJ       10500132
         DC    3C'0'                             NOT RESET              10500133
SYSUPS   DC    X'00'                   UPSI                             10500134
SYSS26   DC    C'NAMEXX'                                                10500135
SYSRTA   DC    2FL4'0'                 PC-TIMER-OP.COM-1015 ROUTINES    10500136
         DC    X'0000'                 SYSEOJ SWITCHES                  10500137
SYSSPC   LH    13,SYSRTA                                                10500138
               CH   13,SYSS20                                           10500139
         BC    12,SYSSPD                                                10500140
               MVC  32(8),40                                            10500141
               STH  13,38                                               10500142
               LPSW 32                                                  10500143
SYSSPD         SVC  2                                                   10500144
         DC    C'0901  '               MESSAGE FOR PROG CHECK           10500145
SYSS18   CLR   13,13                    RESET COND CODE TO ZERO         10500146
         MVI   5,C' '                                                   10500147
         B     SYSS11+6                   AND BRANCH TO LOAD PROB PSW   10500148
SYSSLC   DC    C'SYSEOJ'                                                10500149
*                                                                       10500150
SYSUTB   DC    X'00000005'             SYSRES CONTAINS PUB LIMITS       10500151
       DC    X'00080801'                1402,UNIT 08,SYSRDR             10500152
       DC    X'00100602'                1403,UNIT 10,SYSLST             10500153
       DC    X'000A0403'                1442,UNIT 0A,SYSIPT             10500154
       DC    X'00040A04'                1402,UNIT 04,SYSOPT             10500155
SYSUTY DC    X'001F0200'                1052,UNIT 1F,SYSLOG             10500156
         DC    X'00000000'             SYS000                           10500157
         DC    X'00000000'             SYS001                           10500158
         DC    X'00000000'             SYS002                           10500159
         DC    X'00000000'             SYS003                           10500160
         DC    X'00000000'             SYS004                           10500161
*  *  *  TAPE BIASED SIMPLER SCHEDULER *  *  *                          10500162
SYSENS   EQU   SYSS00+24                HOLD C SENSE INFO               10500163
SYSHLD EQU   8           HOLDING AREA FOR TYPE MSG                      10500164
SYSUSE EQU   19                         BYTE SHOWS ACTIVITY ON CHANNLS  10500165
*            * * * REQUEST I/O ENTRY POINT * * *                        10500166
* * *  SPVR  LOADED REG 12  FOR ME                                      10500167
SYSXCP LH    13,0(12)                   LOAD CCB ADDRESS                10500168
* * *  NEED  AND ABOVE 32 K                                             10500169
       LA    12,2(12)                   ADD 2 TO GET RETURN ADDRESS     10500170
       STH   12,38                      STORE RETURN ADDRESS            10500171
       NC    0(5,13),SYSXZA             ZERO LINK AND COMMUNICATIONS    10500172
SYSQDE   TM    2(13),X'04'              SHOULD THIS CCB WAIT FOR DEV E  10500173
         BC    8,SYSAAA                 BYPASS STASH IN WAITING LIST    10500174
* * *    PUSH DOWN LIST OF DEVICES SIG AT DEV END                       10500175
       STH   13,SYSVCB                  STORE CCB ADDRESS               10500176
         MVC   SYSA01(SYSLNG),SYSA01+2       PUSH DOWN LIST             10500177
SYSAAA  EQU  *                                                          10500178
       STH   13,SYSVCB                  SAVE CCB ADDRESS                10500179
       LH    13,4(13)                    LOAD SYMBOLIC ADDRESS          10500180
       SR     12,12                     ZERO REGISTER                   10500181
       IC    12,SYSUTB(13)              PULL CHANNL                     10500182
       AR     12,12                     DOUBLE CHANNEL                  10500183
       OC    SYSUSE(1),SYSXCN-SYSS00(12) SET CHANNEL USE BYTE           10500184
*            * * * PLACE CCB AT END OF Q AND LINK * * *                 10500185
       LA    13,SYSQMX(12)              LOAD ADDRESS OF HEAD OF Q       10500186
SYSQLL CLI   0(13),X'00'                TEST CORE FOR BLANK ADRESS      10500187
       BC    8,SYSQLK                   END OF Q   SO PASS TO STORE CCB 10500188
       LH    13,0(13)                   PULL LINKAGE ADDRESS            10500189
     B       SYSQLL                                                     10500190
SYSQLK MVC   0(2,13),SYSVCB               PUT THIS CCB AT END OF Q      10500191
       CLI   SYSXPT-SYSS00(12),X'07'    EXPECT INTERRUPT THIS CHANNEL Q 10500192
       BNE   SYSXST                     EXIT SUPVR IF NOW EXPECT INTRPT 10500193
SYSQST MVC   56(8),32                                                   10500194
*            * * * START I/O FOR THIS Q      * * *                      10500195
SYSUA1 LH    13,SYSQMX-SYSS00(12)       PULL HEAD OF Q CCB ADDR         10500196
       MVC   74(2),6(13)                PULL CCW ADDR INTO CAW          10500197
       LH    13,4(13)                   LOAD SYMBOLIC ADDRESS           10500198
         CLI   SYSUTB-SYSS00+2(13),X'00'     IS THIS DEVICE A TAPE      10500199
         BNE   SYSWF1                   BRANCH IF NOT                   10500200
         NI    SETMOD,X'03'             SET MODE BITS OFF               10500201
         OC    SETMOD(1),SYSUTB-SYSS00+3(13)      SET MOD ON            10500202
         MVC   SYSTIC+2(2),74          PLACE CCW INTO TIC               10500203
         MVC   74(2),ADSTMD+2           PLACE SET MODE ADDR INTO CAW    10500204
SYSWF1   LH    13,SYSUTB(13)            PUT CHNL, DEVICE IN REGISTER    10500205
SYSWFH   B       SYSWIO            BYPASS WOIT                          10500206
       MVI   SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10500207
         MVI     SYSXWW+1,X'00'                                         10500208
         TIO     0(13)             CHECK CHANNEL END                    10500209
         BC      6,*-4             WAIT FOR DEVICE END                  10500210
*            * * * START I/O ROUTINE    * * *                           10500211
SYSWIO SIO   0(13)           START IO                                   10500212
       STH   13,58                      IF CSW STORED NEED CH/UN ADRES  10500213
       BC    7,*+8            BYPASS SET EX PECT                        10500214
       STH   13,SYSXPT-SYSS00(12)       MOVE CHNL,DEVICE TO 5XP53T 9N3  10500215
       BC    10,SYSXWW                  GET OUT IF CC IS 0,2            10500216
       BC    1,SYSXMN                   OVERFLO FOR NOT OPERATIONAL     10500217
         NI    SYSUIS+1,X'0F'           IMMEDIATE END                   10500218
       TM    68,X'10'                   DEVICE BUSY                     10500219
       BC    12,SYSXBB                  NO SO ERR OR IMMED END          10500220
       TM    68,X'04'                   DEVICE END                      10500221
       BC    1,SYSWIO                   TRY AGAIN D.E INT WAS PENDING   10500222
SYSXWW BC    15,SYSXIT                  BUSY BUT NO END SAYS TRY LATER  10500223
       TIO   0(13)                                                      10500224
       BC     2,*-4              WAIT FOR CHANNEL END                   10500225
       BC    15,SYSXBB                  END OF WAIT,CHECK ERRORS        10500226
*            * * * I/O INTERRUPT                                        10500227
SYSXIN SR     12,12                     ZERO REGISTER                   10500228
         OI    SYSUIS+1,X'F0'           I/O INTRPT  NOT INISL SELECTION 10500229
       IC    12,58                       INSERT CHANNEL                 10500230
       AR    12,12                      DOUBLE CHANNEL                  10500231
SYSXCK CLC   SYSXPT-SYSS00(2,12),58      EXPECT INTRUPT THIS CH,DEVICE  10500232
      BC  7,SYSXAT       TEST ATTENTION ETC                             10500233
* * *  ANALYSE FOR ERRORS, INTERRUPT OR CSW STORED                      10500234
SYSXBB LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS FOR SET ERR FL 10500235
       TM    69,X'3F'                   TEST CHNNL,DATA,CONTROL,INTFACE 10500236
       BC    7,SYSQCC                   CHANNNEL ERRORS HARD STOP       10500237
SYSXCC TM    68,X'01'                   TEST UNIT EXCEPTION,END FILEETC 10500238
       BC    8,SYSXUC                   BR TO UNIT TEST UNIT CHECK      10500239
       OI    3(13),X'04'                TURN ON UNIT EXCEPTION          10500240
SYSXUC TM    68,X'02'                   UNIT CHECK                      10500241
       BC    7,SYSWUC                   YES,GO TO WORK UNIT CHECK       10500242
* * *  NO ERRORS ASSUME CHANNEL END                                     10500243
SYSUDE TM    68,X'04'                   DEVICE END                      10500244
       BC    8,SYSWUP                   NO LEAVE IT IN LITST            10500245
       OI    3(13),X'01'                SET END  DEV END BIT            10500246
SYSWUP BC    0,SYSQXC                   ER RTN CUT Q BY BRANCH HERE     10500247
       TM    69,X'80'                   PROG  CONTR INTR                10500248
       BC    8,SYSPST             NO CONTINUE                           10500249
         OI    4(13),X'80'              TURN PCI BIT ON                 10500250
         TM    69,X'08'                 CHANNEL END                     10500251
         BNE   SYSXIT                                                   10500252
SYSPST OC    2(1,13),69                 OR IN WLR,PCI  BITS             10500253
       OI    2(13),X'80'                POST TRAFFIC BIT                10500254
SYSUPD MVI   SYSXPT-SYSS00(12),X'07'    SAY CHNL NOT EXPECT INTERRUPT   10500255
       MVC   SYSQMX-SYSS00(2,12),0(13)  MOVE NEXT TO HEAD OF Q          10500256
       MVC   0(2,13),70                 PUT RESIDUAL COUNT IN CCB       10500257
SYSQTT CLI   SYSQMX-SYSS00(12),X'00'     IS Q EMPTY                     10500258
       BC    6,SYSUA1                   NO,TRY TO START I O             10500259
       NC    SYSUSE(1),SYSXCN+1-SYSS00(12) CLEAR BIT IN CHANNEL USE BY  10500260
SYSXIT LPSW  56                         RETURN VIA LOAD OLD PSW         10500261
SYSXRS XC    SYSQMX(8),SYSQMX           TURN Q A TO ZERO                10500262
       MVI   SYSXPT,X'07'               NOT EXXECT ON MPX CHANNEL       10500263
       MVC   SYSXPT+1(7),SYSXPT         NOT EXPECT ON ANY CHNNL         10500264
       MVI   SYSUSE,X'00'               SET CHANNEL ACTIVITY TO ZERO    10500265
SYSVRR MVI   SYSWUP+1,X'00'             NOP ERR I/O RETURN IF ERR CH OK 10500266
         MVI     SYSXWW+1,X'F0'         RESET BRANCH AFTER SIO          10500267
       MVI   SYSQXR+1,X'F0'             SET SWITCH TO BR AS NORMAL      10500268
       MVI   SYSWFH+1,X'F0'             SET SW TO BRANCH                10500269
       CLI   SYSWFF+1,X'00'  '             IS SWITCH TO BRANCH          10500270
       BCR   8,13                       NO, RETURN                      10500271
         LM    1,11,SYSVRX              RESTORE REGISTERS               10500272
       MVI   SYSWFF+1,X'00'             SWITCH TO SAVE PSW              10500273
       BCR   15,13                     RETURN                           10500274
*            * * * TEST UNIT CHECKS     * * *                           10500275
SYSWUC OI    2(13),X'20'                SET UNCORRECTABLE ERROR BIT CCB 10500276
       TM    2(13),X'01'                USER ERROR RTN                  10500277
       BC    1,SYSWUP                   YES,RETURN TO USER              10500278
SYSWFF BC    0,SYSXFF                   BYPASS SAVE PSW AND STATUS      10500279
SYSVRZ   STM   1,11,SYSVRX              SAVE REGISTERS FOR WORK         10500280
       LM    1,5,SYSAVE       SAVE CORE BY REG   BCR  * * *             10500281
       MVI   SYSQCT,X'0'                SERO ERROR COUNTER              10500282
SYSXFF OI    SYSWFF+1,X'F0'              TURN ON SWITCH TO BYPASS SAVE  10500283
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10500284
       LH   11,66                       NEXT CCW     INTO REG           10500285
         SH   11,SYSC08                SUBTRACT 8 TO GET LAST CCW       10500286
       STH  11,66         SAVE NEW CCW IN CORE                          10500287
       MVC   SYSVCW(12),64               SAVE CSW,   CAW                10500288
       MVI     50,X'1F'                 1F  FOR UNIT CHECK              10500289
       XC    SYSENS(6),SYSENS           SET SENSE TO ZERO               10500290
       LH    9,58                                                       10500291
       MVC   74(2),SYSXSC                SENSE CCW                      10500292
       SIO   0(9)                       SENSE                           10500293
         BC    6,*-4                                                    10500294
* * * *      ASSUMED  NO ERRORS ON SENSE  SINCE UNIT CHECK SAYS CONTR   10500295
* * * *                UNIT IS OPERATIONAL                              10500296
* * * *      ASSUME  NO OUTSTANDING INTRPS SINCE GOT SOME KIND OF ENDA  10500297
* * * *              SHORT WHILE BACK                                   10500298
       TIO   0(9)                                                       10500299
       BC   2,*-4            WAIT FOR END OF SENSE                      10500300
       MVC   64(12),SYSVCW                   RESTORS   CSW  CAW         10500301
       IC    8,SYSQCT                   READY TO STEP COUNTER           10500302
SYSCSP LA    8,1(8)                     ADD ONT TO COUNTER              10500303
       STC   8,SYSQCT                   PUT CNTR IN CORE                10500304
       LH     8,4(13)                   PULL SYMBOLIC UNIT              10500305
       IC     8,SYSUTB+2(8)              PULL DEVICE TYPE               10500306
       LH    8,SYSXTE(8)               PULL TABLE ADDRESS               10500307
       BCR   15,8                                                       10500308
SYSQCC MVI   50,X'0F'                   CHANNEL ERROR                   10500309
       LPSW   112                       SIMULATE MACH CHECK             10500310
SYSXMN   MVI     50,X'3F'          NOT OPERATIONAL  3F                  10500311
       LH    13,SYSQMX(12)              PULL CCB ADDRESS                10500312
*            * * * DISTASTER OR DUMP EXIT * * *                         10500313
SYSQXD OI    2(13),X'20'                DISASTER BIT                    10500314
       TM    2(13),X'10'                ACCEPT BAD I/O                  10500315
       BC    1,SYSQXK                   YES  CONTINUE  NO CLEAR DISAST  10500316
* * *  DISASTER BIT ONLY BELONGS ON IF BITS X'11' I(13) ARE ON * * * *  10500317
       LPSW    112                                                      10500318
* * *  OPERATOR CHOICE EXIT                                             10500319
SYSQXP UNPK  SYSHLD(5),58(3)            PUT CH/UN REL                   10500320
SYSC08   EQU   *-4                     CONSTANT OF 8                    10500321
       UNPK  SYSHLD+4(5),SYSENS(3)      UNPACK SENSE INFO               10500322
       TR    SYSHLD(8),SYSTBL-240       CONVERT HEX TO CHARACTER FOR PR 10500323
       MVC   SYSXM1(4),SYSHLD           SET MESSG1 FOR MACRO            10500324
       MVC   SYSXM2(4),SYSHLD+4         SET MESSG2 FOR MACRO            10500325
         STM   12,13,SYSDRG             SAVE REGISTERS SINCE SUP USES T 10500326
       SVC   2           CALL VOR MESSAGE                               10500327
SYSXM1   DC    C'CHUN  '                CHANNEL AND UNIT MESSAGE        10500328
       SVC   2           CALL FOR MESSAGE                               10500329
SYSXM2   DC    C'SENSA '                SENSE MESSAGE                   10500330
         LM    12,13,SYSDRG             RESTORE SAVED REGISTER S        10500331
         CH    12,SYSXCK+4                                              10500332
         BC    2,SYSQXC                                                 10500333
       CLI   SYSXM2+5,C'5'              IS REPLY RETRY                  10500334
* * *  RETRY EXIT                                                       10500335
       BC    8,SYSQXR                   GO TO RTN                       10500336
*            * ** CONTINUE EXIT         * * *                           10500337
SYSQXC NI    2(13),X'DF'                TURN OFF DISASTER BIT           10500338
SYSQXK CLI   SYSQXR+1,X'00'             WAS THIS I/O FROM RROR RTN      10500339
SYSXEE   MVI     SYSQXR+1,X'F0'    SWITCH FOR RESET OPER  SET IT TO BR  10500340
          BC     8,2(10)                   RETURN TO ERR RTN            10500341
       BAL   13,SYSVRR                 RESTORE REGISTERS                10500342
SYSWDE BC  0,SYSPDE                                                     10500343
       LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS F              10500344
       BC    15,SYSWUP                  UPDATE AND CONTINUE             10500345
SYSQXR BC    15,SYSUA1                  NORMAL RETRY                    10500346
SYSQXS MVC   74(2),0(10)                LOAD CAW                        10500347
       LH    13,58          SET UP CHANNEL,UNIT ADDRESS                 10500348
       OI    SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10500349
         MVI     SYSQXR+1,X'00'    SWITCH FOR RESET OPER  NOP           10500350
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10500351
       BC    15,SYSWFH+4                USE  NORMAL START AND TESTS     10500352
SYSSOF   TM    2(13),X'02'              TEST SELECTED ERROR BIT         10500353
         BCR   8,1                      EXIT IF NOT ON                  10500354
         B     SYSXEE                  CONTINUE IF ON                   10500355
SYSXAT   EQU  *                                                         10500356
SYSUNX   LA    12,SYSVCB                 INITIALIZE SEARCH FOR DEV END  10500357
SYSAL1   SH    12,SYSC02                 SUBTRACT 2                     10500358
         CLI   0(12),X'00'              NO CCB                          10500359
         BE    SYSA00                   NONE TRY TESTING Q              10500360
         LH    13,0(12)                 PULL CCB                        10500361
         LH    13,4(13)                 PULL SYMBOL UNIT                10500362
         CLC   SYSUTB-SYSS00(2,13),58   COMPARE INTR CR/UNIT/S CCB C/UN 10500363
         BNE   SYSAL1                   NOT THIS DEVICE                 10500364
         MVI   SYSWUP+1,X'F0'           CUT AT END OF CHECKS            10500365
         MVI   SYSWDE+1,X'F0'           RETURN HERE  DEV END SWITCH     10500366
         LH    13,0(12)                 SET CCB                         10500367
         B     SYSXBB+4                 SIGNIF.INT-CHECK CONDITIONS W/R 10500368
SYSPDE   MVI   SYSWDE+1,X'00'           NOP  DEV END SW                 10500369
         LH    13,0(12)                                                 10500370
         OI    3(13),X'01'                                              10500371
         SH    12,SYSC02                POP UP LIST                     10500372
         MVC   2(2,12),0(12)            UPDATE OUTSTANDING D.E POSSIBLE 10500373
         CLI   0(12),0                  END OF SIG LIST                 10500374
         BNE   SYSPDE+4                 POP UP THE LIST                 10500375
SYSA00   SR    12,12                    SET REG 12 IF ANY SEL CH S POIN 10500376
       IC    12,58                       INSERT CHANNEL                 10500377
       AR    12,12                      DOUBLE CHANNEL                  10500378
SYSQTS CLI   SYSXPT-SYSS00(12),X'07'    AT DEVICE END  NEED TO TST EXPT 10500379
       BC    4,SYSXIT                   LESS,REALL CHANNEL NUMBER       10500380
     B     SYSQTT                                                       10500381
* * *    CHECK DEVICE END                                               10500382
SYSC02 DC  H'2'                                                         10500383
* * *    DESIGNED FOR PRTOV MACRO                                       10500384
       DC  H'0'                                                         10500385
SYSA01 DC   2H'0'                       PUSH DOWN LIST FOR DVE SIG CCB  10500386
       DC   2H'0'                                                       10500387
LAST   DC   2H'0'                                                       10500388
SYSVCB DC    H'0'                                                       10500389
L      EQU   SYSVCB-SYSA01              LINGTH OF PUSH DOWN LIST        10500390
SYSLNG EQU   SYSVCB-SYSA01              LENGTH OF PUSH DOWN LIST        10500391
* * *    IF DEVICE END SIGNIFIGANT, TEST CH9,CH12,WITH I/O ERROR RTNS.  10500392
SYSXZA DC    X'00001F000F'              MASK,AND BYTES 0-3 OFF          10500393
SYSQCT DC    X'0'                  COUNTER FOR ERROR ROUTINES           10500394
*      TABLE  OF ERROR ENTRYS           * * *                           10500395
SYSXTE DC   Y(SYSTER)           TAPE ERROR RTN                          10500396
       DC      Y(SYSUIS)                1052 TYPEWRITER  ERROR          10500397
       DC      Y(SYSUAA)                1442 READ/PCH   ERROR           10500398
       DC      Y(SYSUCG)                1403 PRINTER    ERR/R           10500399
       DC      Y(SYSUCD)                1402  READER    ERR/R           10500400
       DC      Y(SYSUCC)                1402 PUNCH,PFR  ERR/R           10500401
       DC     Y(SYSD10)           DISK ROUTINES                         10500402
       DC      Y(SYSUKA)                1015 ERROR ROUTINES             10500403
       DC      Y(SYSP00)                2671 ERROR ROUTINES             10500404
       DC      Y(SYSUAB)                1443 PRINTER   ERROR            10500405
SYSUKA EQU   SYSQXD                     NO 1015 ERROR ROUTINES          10500406
SYSD10   EQU   SYSQXD                                                   10500407
SYSP00 EQU   SYSQXD                     NO 2671 ERROR ROUTINES          10500408
SYSXSC DC      Y(SYSXSN)                ADDR OF SENSE CCW               10500409
*                                                                       10500410
SYSQMX DC    3H'0'                      HEAD Q FOR MULTPLX,2SEL         10500411
SYSMSG   DC      Y(SYSSCB-2)           POINT TO CCB FOR SVC2            10500412
SYSXCN DC    X'807F'                    OR CH USE BYTE    AND IT OFF    10500413
       DC    X'40BF'                    OR CH USE BYTE    AND IT OFF    10500414
       DC    X'20DF'                    OR CH USE BYTE    AND IT OFF    10500415
SYSXPT DC    3X'0700'                   EXPECT INTERRUPT ON CHANNL      10500416
       DC     X'0700'                                                   10500417
***   AREA FOR SAVING REGISTERS                                         10500418
SYSVRX   DS    11F                      ROOM TO SAVE REMAINING REG.     10500419
SYSDRG   DS    D                                                        10500420
SETMOD   CCW   X'03',SETMOD,X'60',80     SET MODE COMMAND               10500421
SYSTIC   DC    X'08000000'              TIC COMMAND                     10500422
ADSTMD   DC      A(SETMOD)              ADDRESS OF SET MODE COMMAND     10500423
       DC  X'00FAFBFCFDFEFF00'          TRANSLATE LETT5RS 256OR5 G+     10500424
SYSXSN CCW   X'04',SYSENS,X'20',6       SENSE BYTES I/O CCW             10500425
SYSVCW   DC    3F'0'                                                    10500426
SYSAVE DC    A(SYSQXD)                  EXIT   DISASTER                 10500427
       DC    A(SYSQXC)                  EXIT   CONTINUE                 10500428
       DC    A(SYSQXR)                  EXIT   RETRY                    10500429
       DC    A(SYSQXP)                  EXIT   OPERATOR CHOICE          10500430
       DC    A(SYSQXS)                  EXIT   START I/O FOR ADJ BACKSP 10500431
SYSTBL DC    CL16'0123456789ABCDEF'            TABLE LOOK UP FOR HEX TR 10500432
*        **********  /360 TAPE ERROR ROUTINE  **********                10500433
         DS    0D                      START PROGRAM ON DOUBLE WORD     10500434
SYSTOS   EQU   6                       EQU TO GEN REG 6                 10500435
SYSTOT   EQU   7                       EQU TO GEN REG 7                 10500436
SYSTIO   EQU   10                      EQU TO GEN REG 10                10500437
SYSTIA   EQU   11                      EQU TO GEN REG 11                10500438
SYSTOP   EQU   13                      EQU TO GEN REG 13                10500439
SYST22   DC    X'2700000140000001'     BACKSPACE CCW + CHAIN FLAG       10500440
SYST33   DC    X'1700000100000001'     ERASE GAP CCW                    10500441
SYST44   DC    X'3700000100000001'     FWD, BKSP OR NOP CCW             10500442
SYST55   CCW   X'04',SYST66,X'20',2    SENSE CCW                        10500443
SYST66   DC    H'0'                    SENSE READ IN AREA               10500444
SYSTER   TM    SYSENS,X'FF'            ANY SENSE DATA                   10500445
         BCR   8,SYSUXC                                                 10500446
         MVI   SYST44,X'27'            MODIFY CCW TO BKSP               10500447
         TM    SYSENS,X'22'            BUS OUT CHECK OR WORD COUNT ZERO 10500448
         BC    5,SYST10                                                 10500449
         BAL   SYSTIO,SYSTSE           GO TO SUB-ROUT.--EQUIP + INT REQ 10500450
         MVN   SYST44+3(1),0(SYSTIA)   GET OP CODE FROM CCW COMMAND     10500451
         NI    SYST44+3,X'07'          REMOVE MOD BIT IF RD BKWD COMMD  10500452
         TM    SYSENS,X'0C'            TEST FOR DATA OR OVERRUN CHECK   10500453
         BC    7,SYST01                                                 10500454
         TM    3(13),X'08'              TEST DATA CONVERTOR             10500455
         BZ    SYST11                   NO                              10500456
         OI    3(SYSTOP),X'08'          SET DATA CONVERTOR              10500457
       BR      SYSUXC                                                   10500458
SYST01   CLI   SYST44+3,X'04'          IS THIS A RD BKWD COMMAND        10500459
         BC    7,SYST02                NO,                              10500460
         MVI   SYST44,X'37'            YES, MODIFY CCW TO FRDSPACE      10500461
SYST02   TM    SYSENS,X'04'            IS THIS AN OVERRUN CONDITION     10500462
         BO    SYST03                  YES                              10500463
         TM  SYSENS+1,X'80'             NOISE RECORD                    10500464
         BC   1,SYSTXY                                                  10500465
         LH    7,6(11)                  PLACE ORIG CT IN 7              10500466
         SH   7,70    SUB  RESID  CT                                    10500467
         LA    6,12                                                     10500468
         CR    7,6                                                      10500469
         BCR   4,SYSUXR                 RETRY  NOISE REC IF CT LESS 12  10500470
SYSTXY   CLI   SYST44+3,X'01'          IS THIS A WRITE OPER             10500471
         BZ    SYST05                  YES                              10500472
         TM    SYSQCT,X'07'            HAS 8 ATTEMPTS BEEN TRIED        10500473
         BZ    SYST06                  YES                              10500474
         TM    SYSENS+1,X'10'          IS THIS A 7 TRACK OPER           10500475
         BO    SYST03                  YES                              10500476
         TM    SYSENS+2,X'FF'          HAS TRACK IN ERROR BEEN IDENT    10500477
         BC    7,SYST03                NO                               10500478
         BALR  SYSTIO,SYSUXS                                            10500479
         DC      Y(SYST44)                REQUEST EXECUTED              10500480
         MVI   SYST44,X'1B'            MODIFY CCW OP TO REQUEST TIE     10500481
SYST03   CLI   SYSQCT,100                                               10500482
         BC    10,SYST04               YES                              10500483
         BALR  SYSTIO,SYSUXS                                            10500484
         DC      Y(SYST44)                REQUEST EXECUTED              10500485
SYSTBS   STH   SYSTIA,SYSTDC            CCW ADDRESS IS PLACED IN RETURN 10500486
         BALR  SYSTIO,SYSUXS                                            10500487
SYSTDC   DC      Y(SYSTDC)              WITH NEW CCW                    10500488
       BR    SYSUXC                     CONTINUE                        10500489
SYST04   TM    SYSENS,X'04'            TEST FOR OVERRUN CONDITION       10500490
         BCR   1,SYSUXD                                                 10500491
         OI    3(SYSTOP),X'10'          SET UNCORRECTABLE RD ERR        10500492
         B     SYSSOF                                                   10500493
SYST05   BALR  SYSTIO,SYSUXS                                            10500494
         DC      Y(SYST22)                ERASE GAP                     10500495
         CLI   SYSQCT,4                TEST FOR 3 WRITE ATTEMPTS        10500496
         BCR   4,SYSUXR                                                 10500497
         MVI   SYSENS+1,X'F3'          INIT '3 WRITE ERRORS' MESSG.     10500498
         BR    SYSUXD                                                   10500499
SYST06   MVI   SYST44,X'27'            ROUTINE                          10500500
         LA    SYSTOS,3                 TO                              10500501
         LH    SYSTOT,SYST44+2           INCORPORATE                    10500502
SYST07   BALR  SYSTIO,SYSUXS                                            10500503
         DC      Y(SYST44)                 CLEANING                     10500504
         BALR  SYSTIO,SYSUXS                                            10500505
         DC      Y(SYST55)                   WHEN                       10500506
         TM    SYST66+1,X'08'                 EVER                      10500507
         BO    SYST08                          8                        10500508
         BCT   SYSTOS,SYST07                    READ                    10500509
SYST08   XI    SYST44,X'10'                      ERRORS                 10500510
         SR    SYSTOT,SYSTOS                      ARE                   10500511
         BCR   8,SYSUXR                                                 10500512
SYST09   BALR  SYSTIO,SYSUXS                                            10500513
         DC      Y(SYST44)                                              10500514
         BCT   SYSTOT,SYST09                                            10500515
         B     SYSTBS                  EXIT TO RETRY                    10500516
SYST10   CLI   SYSQCT,3                TEST COUNTER FOR 3 ATTEMPTS      10500517
         BCR   10,SYSUXD                                                10500518
         TM      SYSENS,X'02'           READ CT ZERO                    10500519
         BCR   1,SYSUXR                                                 10500520
         CLI   SYST44+3,X'01'          IS COMMAND A WRITE OPER          10500521
         BCR   7,SYSUXR                                                 10500522
         B     SYST03                                                   10500523
SYST11   CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10500524
         CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10500525
         BCR   8,SYSUXD                                                 10500526
         BR    SYSUXP                                                   10500527
*                                                                       10500528
SYSUXD EQU   1         REGISTER 1     DISASTER                          10500529
SYSUXC EQU   2           REGISTER 3  NO ERROR  CONTINUE                 10500530
SYSUXR EQU   3           REGISTER 3  RETRY THE LAST CCB                 10500531
SYSUXP EQU   4          GREGISTER 4   OPERATOR CHOICE                   10500532
SYSUXS EQU   5           REGISTER 5  ROUTINE FOR RESET,BACKSPACE,ETC    10500533
SYSTSE   TM      SYSENS,X'10'      EQUITMENT CHECK                      10500534
         BCR     1,SYSUXD                                               10500535
SYSTSO   TM      SYSENS,X'40'      OPERATIO INTERVENTION                10500536
         BCR     1,SYSUXP          GO TO OPERATIO  CHOICE               10500537
         BR    10                                                       10500538
***** ERROR ROUTINE FOR PRINTERS,READERS AND PUNCH FOR TAPE SYSTEM ***  10500539
SYSTSU   TM    SYSENS,X'58'                                             10500540
         BCR   5,SYSUXP                                                 10500541
SYSUBT TM    SYSENS,X'20'               BASIC TEST ROUTINE     BUSS OUT 10500542
       BC    1,SYSUIS                   BUS OUT,SWITCH FOR RETRY        10500543
       TM    SYSENS,X'80'               COMMAND REJECT                  10500544
       BCR   1,SYSUXD                   GO TO DISASTER                  10500545
       BR    10                         NONE OF THESE  RETURN TO DEV RT 10500546
***** ENTER ROUTINE HERE FOR 1402 PUNCH ERROR *****                     10500547
SYSUCC TM    SYSENS,X'10'               EQUIPMENT CHECK                 10500548
       BC    8,SYSUCD                   NO,USE 1402R ROUTINES           10500549
SYSUDA   OI    3(13),X'11'             SET BIT IN CCB                   10500550
         B     SYSSOF                   EXIT TO TEST SOFT ERR BIT       10500551
***** ENTER ROUTINE HERE FOR 1402 READER ERROR *****                    10500552
SYSUCD   NI    SYSUIS+1,X'0F'           KNOW CAN RETRY BUS OUT ON 1402  10500553
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10500554
SYSUDB   OI       3(13),X'08'     SET BIT IN CCB                        10500555
         BR    SYSUXC             BRANCH TO CONTINUE                    10500556
***** ENTER ROUTINE HERE IF 1403 OR 1404 ERROR *****                    10500557
SYSUCG BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10500558
       TM    SYSENS,X'02'               USUSUAL COMMAND SEQUENCE        10500559
       BC    1,SYSUDB                   USE POSTING RTN                 10500560
       OI    3(13),X'02'                SET CH 9 OVERFLOW BIT           10500561
         BC    15,SYSUDE                CONTINUE                        10500562
***** ENTER ROUTINE HERE IF 1442,2520 OR 2501 ERROR *****               10500563
SYSUAA BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10500564
         BR      SYSUXP           BRANCH TO OPERATOR CHOICE             10500565
***** ENTER ROUTINE HERE FOR 1443         ERROR *****                   10500566
*      1403  ALSO- COULD B UCG+4 * * *                                  10500567
SYSUAB   NI   SYSENS,X'F3'                                              10500568
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10500569
         TM    SYSENS,X'01'                                             10500570
         BCR   8,SYSUXC                                                 10500571
       OI    3(13),X'02'                SET BIT IN CCB                  10500572
         BC    15,SYSUDE                                                10500573
***** ENTER ROUTINE HERE FOR 1052 ERROR ALSO COMMON BUS-OUT ROUTINE     10500574
SYSUIS BCR   15,SYSUXP                  OPERATOR CHOICE IF COMMAND EXEC 10500575
       CLI   SYSQCT,3                   TRIED 3 TIMES                   10500576
       BCR   12,SYSUXR                  RETRRY                          10500577
       BR    SYSUXP                     OPERATIOR CHOICE                10500578
SYSSND EQU   *        ENS OF SUPERVISOR                                 10500579
*                                                                       10500580
ABSLUT     SVC   0                                                      10500581
SYSLDR EQU   ABSLUT                                                     10500582
READCD  EQU  ABSLUT                                                     10500583
           DC    YL2(CCCB)                                              10500584
       TM    CCCB+2,X'80'       WAIT FOR END                            10500585
       BZ   *-4                                                         10500586
TEXTCD     EQU   *                                                      10500587
       L     15,INPUT                  3 TESTS CHEAPER WITH REGISTER    10500588
       CL    15,CREP                                                    10500589
       BZ    REPRUT                                                     10500590
           L     14,INPUT+4              SET UP ADDRESS EITHER BR OR DA 10500591
       CL    15,CEND                                                    10500592
       BCR   8,14               END CARD, GOT TO ADDRESS                10500593
       CL    15,CTXT                                                    10500594
       BC    7,READCD                  NOT  ANDY LIGIT CZRD IGNORE IT   10500595
           LH    15,INPUT+10            COUNT                           10500596
TXTCNT  BCTR  15,0       REDUCE COUNT BY 1                              10500597
           STC   15,MOVETX+1                                            10500598
MOVETX     MVC   0(0,14),INPUT+16        MOVE DATA                      10500599
       B     READCD                                                     10500600
REPRUT TR    INPUT+6(6),SYSTBL-240      BYTE TO HEX   C1 = FA  ETC      10500601
       PACK  INPUT(5),INPUT+6(7)          ADDRESS TO HEX                10500602
       LA    14,INPUT+11                FROM ADDRESS  FIRST REPLACE     10500603
       LA    15,INPUT+16                INTO ADDRESS  FIRST REPLACE     10500604
REPLP  LA    14,5(14)                   ADD 5 TO FROM ADDRESS           10500605
       MVC   SAVE(4),0(14)              SAVE  4 BYTES                   10500606
       TR    SAVE(4),SYSTBL-240         BYTE TO HEX                     10500607
       PACK   0(3,15),SAVE(5)           PACK, DROP SIGN  ZONES          10500608
       LA    15,2(15)                   MODIFY INTO ADDR                10500609
       CLI   4(14),C','                 IS IT COMMA  LAST MUST BE BLANK 10500610
       BC    8,REPLP                    YES, MORE BYTES                 10500611
REPXT  SH    15,REPRUT+18               COUNT OF BYTES REPLACES         10500612
       L     14,INPUT                   ADDRESS OF FIRST BYTE           10500613
       B     TXTCNT                                                     10500614
SAVE   DC    X'00000000'    ROOM FOR PACK  ETC                          10500615
INPUT      DS    10D                                                    10500616
MSCCW3     DC    X'02'             READ                                 10500617
            DC   AL3(INPUT)                                             10500618
           DC    A(80)                                                  10500619
CTXT       DC    X'02E3E7E3'                                            10500620
CEND       DC    X'02C5D5C4'                                            10500621
CCCB       DC    F'0'                                                   10500622
           DC    H'4'                                                   10500623
           DC    YL2(MSCCW3)                                            10500624
CREP   DC    X'02'                                                      10500625
       DC    C'REP'                                                     10500626
JOBCT      LPSW  SYSSLB                                                 10500627
       END  JOBCT                                                       10500628
         TITLE 'JOB CONTROL'                                            10500629
NRSUP    START 0                                                        10500630
         USING *,0,4                                                    10500631
SJW4RG   EQU   1                                                        10500632
SJCCRG   EQU   2                        CARD INDEX REGISTER             10500633
SJCTRG   EQU   4                        COUNTING REGISTER               10500634
SJW1RG   EQU   5                        WORK REGISTER                   10500635
SJW2RG   EQU   6                        WORK REGISTER                   10500636
SJW3RG   EQU   7                        WORK REGISTER                   10500637
SJTBRG   EQU   8                        TABLE INDEX REGISTER            10500638
SJCRRG   EQU   9              CONTAINS ADDR OF START OF COMMUNICAT REG  10500639
SJFBRG   EQU   10                  CONTAINS ADDR OF FILL BUCKET ROUTINE 10500640
SJSBRG   EQU   11                  CONTAINS ADDR OF SKIP BLANKS ROUTINE 10500641
SJBRRG   EQU   14                       SUBROUTINE ADDR REGISTER        10500642
SJLKRG   EQU   15                       RETURN LINKAGE REGISTER         10500643
SJCRJB   EQU   38                  JOB CONTROL BYTE IN COMMUN. REGION   10500644
SJCRJC   EQU   39                  JOB CONTROL BYTE IN COMMUN. REGION   10500645
SJCRUP   EQU   23                  UPSI BYTE                            10500646
SJCRCF   EQU   9                   CONFIGURATION BYTE                   10500647
SJCRMO   EQU   0                   MONTH-2 BYTES                        10500648
SJCRDA   EQU   2                   DAY-2BYTES                           10500649
SJCRYR   EQU   4                   YEAR-5BYTES                          10500650
SJCRNM   EQU   24                  NAME-6BYTES                          10500651
SJCRUS   EQU   20                                                       10500652
         ORG   NRSUP+4096                                               10500653
START    BALR  3,0                                                      10500654
         USING *,3                                                      10500655
         LH    SJCRRG,20     SET CRREG TO ADDR OF COMM. REGION          10500656
         LA    SJFBRG,SJFLBK       INIT REG TO ADDR OF FILL BUCKET ROUT 10500657
         LA    SJSBRG,SJSKBL       INIT REG TO ADDR OF SKIP BLANKS ROUT 10500658
         MVI   SJCRUP(SJCRRG),X'00'    ZERO UPSI BYTE                   10500659
         MVC   SJEOJM+6(6),SJCRNM(SJCRRG)        PUT NAME IN EOJ MESG   10500660
         TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10500661
         BC   14,SJNEOJ                      BRANCH NOT EQUAL           10500662
         TM    SJCRJB(SJCRRG),X'80'          IS LOG FLAG ON             10500663
         BC   14,SJNEOJ                                                 10500664
         MVI   SJEOJM,C'N'                   INIT FOR NORMAL EOJ  MSG   10500665
         TM    SJCRJB(SJCRRG),X'01'          WAS JOB ABORTED            10500666
         BC   14,SJTEOJ                                                 10500667
         MVI   SJEOJM,C'A'                   INIT FOR ABNORMAL EOJ MSG  10500668
SJTEOJ   SVC   0                             WRITE EOJ MESSAGE          10500669
         DC    YL2(SJECCB)                                              10500670
         TM    SJECCB+2,X'80'                                           10500671
         BC    8,*-4                                                    10500672
SJNEOJ   NI    SJCRJB(SJCRRG),X'80'          RESET ALL BUT LOG FLAG     10500673
         MVC   SJCRUS(3,SJCRRG),SJNUMT                                  10500674
SJREAD   SR    SJCTRG,SJCTRG                                            10500675
         SR    SJW1RG,SJW1RG                                            10500676
         SR    SJW2RG,SJW2RG                                            10500677
         SR    SJW3RG,SJW3RG                                            10500678
         SR    SJW4RG,SJW4RG                                            10500679
         BAL   SJLKRG,SJRDCD                                            10500680
         CLC   SJINPT(3),SJKCTL         TEST IF CONTROL CARD            10500681
         BNE   SJNOSL                  GO TO NO SLASH ROUTINE           10500682
         BAL   SJLKRG,SJDISP                                            10500683
         LA    SJCCRG,SJINPT+2                                          10500684
         BALR  SJLKRG,SJSBRG                                            10500685
         BALR  SJLKRG,SJFBRG                                            10500686
         SR    0,0                                                      10500687
         CLI   SJBUCK+5,C' '            IS VERB GREATER THAN 5 CHAR     10500688
         BNE   SJNOCC                                                   10500689
         CLI   0(SJCCRG),C','           DID COMMA FOLLOW THE VERB       10500690
         BE    SJNOCC                                                   10500691
SJNOBR   BC    0,SJVOL1                NOP-BRANCH SWITCH                10500692
         CLC   SJBUCK(5),SJKPAU         TEST FOR PAUSE CARD             10500693
         BE    SJPAUS                                                   10500694
         CLC   SJBUCK(4),SJKJOB         TEST FOR JOB CARD               10500695
         BE    SJJOB                                                    10500696
         CLC   SJBUCK(4),SJKLOG                                         10500697
         BE    SJLOG                                                    10500698
         CLC   SJBUCK(5),SJKNLG             TEST FOR NOLOG CARD         10500699
         BE    SJNLOG                                                   10500700
         TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10500701
         BZ    SJNOJC                                                   10500702
         LA    SJTBRG,SJTABL       SET REG TO BEGIN OF CTL CD TABLE     10500703
SJCCLU   CLC   2(5,SJTBRG),SJBUCK       COMPARE TABLE ENTRY             10500704
         BE    SJFND                                                    10500705
         CLC   2(5,SJTBRG),SJKASG       TEST FOR END OF TABLE           10500706
         BE    SJNOCC                                                   10500707
         LA    SJTBRG,7(SJTBRG)         INCREMENT FOR NEXT TABLE ENTRY  10500708
         B     SJCCLU                   LOOP FOR NEXT TABLE ENTRY       10500709
SJFND    MVC   SJBCK1(2),0(SJTBRG)                                      10500710
         LH    SJBRRG,SJBCK1            LOAD REG WITH ROUTINE ADDR      10500711
         BR    SJBRRG                   BRANCH TO ROUTINE               10500712
SJRDCD   LA    SJCCRG,SJINPT            INIT CONTROL CARD REGISTER      10500713
         SVC   0                                                        10500714
         DC    YL2(SJCCB)                                               10500715
SJRD1    TM    SJCCB+2,X'80'                                            10500716
         BC    8,SJRD1                                                  10500717
         TM    SJCCB+3,X'04'           TEST EOF                         10500718
         BC    1,SJRDCD                YES-LET IOCS ISSUE MESSAGE       10500719
         BR    SJLKRG                                                   10500720
SJSKBL   CH    SJCCRG,SJEOC            TEST FOR END OF CARD             10500721
         BCR   10,SJLKRG                                                10500722
         CLI   1(SJCCRG),C' '          COMPARE FOR BLANK                10500723
         BNE   0(SJLKRG)                RETURN                          10500724
         LA    SJCCRG,1(SJCCRG)                                         10500725
         B     SJSKBL                                                   10500726
SJFLBK   MVC   SJBUCK,SJ9BLK           BLANK BUCKET                     10500727
         AH    0,SJK01                                                  10500728
         LA    SJW1RG,SJBUCK                                            10500729
SJFB1    CLI   1(SJCCRG),C' '           TEST FOR BLANK                  10500730
         BE    SJBKFL                                                   10500731
         CLI   1(SJCCRG),C','           TEST FOR COMMA                  10500732
         BE    SJBKFL                                                   10500733
         CH    SJCCRG,SJEOC                                             10500734
         BCR   8,SJLKRG                                                 10500735
         CH    SJW1RG,SJEOB             TEST FOR OVERFLOW OF BUCKET     10500736
         BE    SJFB2                                                    10500737
         MVC   0(1,SJW1RG),1(SJCCRG)                                    10500738
         LA    SJW1RG,1(SJW1RG)                                         10500739
SJFB2    LA    SJCCRG,1(SJCCRG)                                         10500740
         B     SJFB1                                                    10500741
SJBKFL   LA    SJCCRG,1(SJCCRG)                                         10500742
         BR    SJLKRG                                                   10500743
SJCNVB   BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10500744
         BALR  SJLKRG,SJFBRG            FILL BUCKET                     10500745
         CLI   SJBUCK+8,C' '                                            10500746
         BNE   SJCCER                                                   10500747
         CLI   0(SJCCRG),C' '           DID BLANK STOP THE SCAN         10500748
         BNE   SJCCER                                                   10500749
         LH    SJCTRG,SJK008            SET COUNTER TO 8                10500750
         LA    SJTBRG,SJBUCK+7          SET REG TO END OF BUCKET ADDR   10500751
         SR    SJW2RG,SJW2RG            ZERO WORK REG                   10500752
SJCVB1   IC    SJW2RG,0(SJTBRG)         PUT ONE CHAR OF PARAM INTO REG  10500753
         CLI   0(SJTBRG),C'1'           IS CHAR A 1                     10500754
         BE    SJCVB2                                                   10500755
         SRL   SJW3RG,1                 SHIFT ODD REG INSERTING A ZERO  10500756
         B     SJCVB3                                                   10500757
SJCVB2   SRDL  SJW2RG,1            PUT A 1 IN HIGH ORDER OF ODD REG     10500758
SJCVB3   BCTR  SJTBRG,0                 SUBTRACT 1 FROM BUCKED ADDR REG 10500759
         BCT   SJCTRG,SJCVB1            LOOP 7 TIMES                    10500760
         SRL   SJW3RG,24           SHIFT HIGH BYTE TO LOW ORDER OF REG  10500761
         BR    SJBRRG                   RETURN TO CONFG OR UPSI ROUTINE 10500762
SJCONF   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10500763
         STC   SJW3RG,SJCRCF(SJCRRG)         STORE CONFG BYTE IN CR     10500764
         B     SJREAD                   GET NEXT CARD                   10500765
SJUPSI   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10500766
         STC   SJW3RG,SJUPSS+1         STORE CHAR IN MASK               10500767
SJUPSS   OI    SJCRUP(SJCRRG),0        OR UPSI CHAR TO UPSI BYTE        10500768
         B     SJREAD                                                   10500769
SJJOB    TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10500770
         BC    1,SJJOB1                      IF ON,GO TO ERROR          10500771
         BALR  SJLKRG,SJSBRG                 SKIP BLANKS                10500772
         BALR  SJLKRG,SJFBRG                 FILL BUCKET                10500773
         MVC   SJCRNM(6,SJCRRG),SJBUCK       MOVE NAME INTO CR          10500774
         OI    SJCRJB(SJCRRG),X'02'          SET JOB FLAG ON            10500775
         B     SJREAD                                                   10500776
SJJOB1   NI    SJCRJB(SJCRRG),X'FD'     RESET JOB CARD FLAG             10500777
         MVC   SJMESG+3(3),SJMSG1       SET UP MESSAGE FOR DOP JOB CARD 10500778
         B     SJMESG                                                   10500779
SJPAUS   TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10500780
         BC    8,SJPAU1                                                 10500781
         OI    SJCRJB(SJCRRG),X'04'     SET PAUSE FLAG ON               10500782
         B     SJREAD                                                   10500783
SJPAU1   MVC   SJMESG+3(3),SJPMSG       INIT PAUSE MESSAGE              10500784
         B     SJMESG                                                   10500785
SJEXEC   EQU   *                                                        10500786
         LH    SJW1RG,22     POINT REG TO SYSLST PUB                    10500787
         LA    SJW1RG,08(SJW1RG)                                        10500788
         NI    SJCRJC(SJCRRG),X'7F'    RESET PRINTER SW                 10500789
         CLI   2(SJW1RG),X'06'         IS SYSLST A PRINTER              10500790
         BE    SJSPS                                                    10500791
         CLI   2(SJW1RG),X'12'                                          10500792
         BNE   SJEXQ1                                                   10500793
SJSPS    OI    SJCRJC(SJCRRG),X'80'          SET PRINTER SW             10500794
SJEXQ1   CLI   SJCRDA(SJCRRG),X'00'     TEST IF DATE WAS SUBMITTED      10500795
         BE    SJNODC                                                   10500796
         TM    SJCRJB(SJCRRG),X'04'     TEST PAUSE FLAG                 10500797
         BC    8,SJEXQ2                                                 10500798
         SVC   2                             DELAYED PAUSE              10500799
         DC    C'1703A '                                                10500800
SJEXQ2   EQU   *                                                        10500801
SJEXQ3   LH    SJW3RG,20               GET                              10500802
         NC    SJLBKT(1),9(SJW3RG)     HIGHEST                          10500803
         LH    SJW3RG,SJKON8           CORE                             10500804
         IC    0,SJLBKT                LOCATION                         10500805
         SRL   0,5                                                      10500806
         STC   0,*+7                                                    10500807
         SLL   SJW3RG,0                                                 10500808
         BCTR  SJW3RG,0                                                 10500809
         MVI   0(SJW3RG),C'*'                                           10500810
SJLAB3   BC    0,SJMLAB                                                 10500811
SJEXQ6   CLI   19,X'00'                ARE ALL I/O FINISHED             10500812
         BNE   SJEXQ6                                                   10500813
         SVC   1                        FETCH PROGRAM                   10500814
SJEXQ4   DC    C'SYSBPD'                                                10500815
SJDATE   BALR  SJLKRG,SJSBRG            SKIP BLANKS IN CTL CARD         10500816
         BALR  SJLKRG,SJFBRG            FILL BUCKET WITH DATE           10500817
* TEST FOR NON-NUMERIC CHARACTER IN DATE FIELD                          10500818
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10500819
         NC    SJBCK1(5),SJK5F0         CONVERT BYTES TO XXXX0000       10500820
         CLC   SJBCK1(5),SJK5F0         TEST IF XXXX0000 ARE 11110000   10500821
         BNE   SJCCER                   IF NO THERE IS A NON NUMERIC    10500822
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10500823
         NC    SJBCK1(5),SJK50F         CONVERT BYTES TO 0000XXXX       10500824
         TRT   SJBCK1(5),SJNUMT         TEST IF ANY NUMBER IS NOT 0-9   10500825
         BC    6,SJCCER                                                 10500826
         CLI   SJBUCK+5,C' '       IS DATE FIELD LONGER THAN 5 CHAR     10500827
         BNE   SJCCER                                                   10500828
         CLI   SJBUCK+4,C' '            IS DATE LESS THAN 5 CHAR        10500829
         BE    SJCCER                                                   10500830
         MVC   SJCRYR(5,SJCRRG),SJBUCK       STORE 5 CHAR DATE IN CR    10500831
         PACK  SJBCK1(8),SJBUCK(2)      PACK THE YEAR                   10500832
         CVB   SJW1RG,SJBCK1            CONVERT TO BINARY THE YEAR      10500833
         MVI   SJFEB,X'1C'             SET FEB TABLE ENTRY TO 28 DAYS   10500834
         N     SJW1RG,SJKW3             AND 0003 TO TEST FOR LEAP YEAR  10500835
         BNE   SJDAT1                                                   10500836
         MVI   SJFEB,X'1D'              SET FEB TABLE ENTRY TO 29 DAYS  10500837
SJDAT1   PACK  SJBCK1(8),SJBUCK+2(3)    PACK THE DAY                    10500838
         CVB   SJW1RG,SJBCK1            CONVERT THE DAY TO BINARY       10500839
         XR    SJCTRG,SJCTRG                                            10500840
         LA    SJTBRG,SJMOTB-1     SET TABLE REGISTER TO ADDR OF MO T12 10500841
SJDAT2   LA    SJCTRG,1(SJCTRG)         ADD ONE TO MONTH COUNTER        10500842
         LA    SJTBRG,1(SJTBRG)         ADD 4 TO TABLE REG              10500843
         STC   SJW1RG,SJDAT             SAVE DATE                       10500844
         IC    SJW2RG,0(SJTBRG)                                         10500845
         SR    SJW1RG,SJW2RG            SUBTRACT MONTH VALUE FROM DATE  10500846
         BP    SJDAT2                   LOOP ON A PLUS RESULT           10500847
         CVD   SJCTRG,SJBCK1            CONVERT MONTH COUNT TO DEC      10500848
         UNPK  SJCRMO(2,SJCRRG),SJBCK1(8)         STORE MONTH IN CR     10500849
         IC    SJCTRG,SJDAT                                             10500850
         CVD   SJCTRG,SJBCK1            CONVERT DAY TO DEC              10500851
         UNPK  SJCRDA(2,SJCRRG),SJBCK1(8)         STORE DAY IN CR       10500852
         OI    SJCRMO+1(SJCRRG),X'F0'                                   10500853
         OI    SJCRDA+1(SJCRRG),X'F0'                                   10500854
         CLC   SJCRMO(2,SJCRRG),SJK12        IS MONTH MORE THAN 12      10500855
         BNH   *+14                                                     10500856
         MVC   SJCRMO(9,SJCRRG),SJNUMT       ZERO DATE FIELD            10500857
         B     SJCCER                                                   10500858
         B     SJREAD                                                   10500859
SJNODC   MVC   SJMESG+3(3),SJNDCM       SET UP MESSAGE FOR NO DATE CARD 10500860
         B     SJMESG                                                   10500861
SJSYSR   BALR  SJLKRG,SJFBRG            PUT SYS*** PARAM INTO BUCKET    10500862
         CLI   0(SJCCRG),C','           TEST FOR COMMA AFTER PARAM 1    10500863
         BNE   SJCCER                                                   10500864
         CLI   SJBUCK+6,C' '                                            10500865
         BNE   SJCCER                                                   10500866
         CLC   SJBUCK(3),SJKSYS                                         10500867
         BNE   SJCCER                                                   10500868
         LA    SJW4RG,4                 PUT DISP FOR SYSRDR IN REG      10500869
         CLC   SJBUCK+3(3),SJKRDR       TEST FOR SYSRDR                 10500870
         BCR   8,SJBRRG                 BRANCH EQUAL                    10500871
         LA    SJW4RG,4(SJW4RG)                                         10500872
         CLC   SJBUCK+3(3),SJKLST       SYSLST                          10500873
         BCR   8,SJBRRG                 BRANCH EQUAL                    10500874
         LA    SJW4RG,4(SJW4RG)                                         10500875
         CLC   SJBUCK+3(3),SJKIPT       SYSIPT                          10500876
         BCR   8,SJBRRG                 BRANCH EQUAL                    10500877
         LA    SJW4RG,4(SJW4RG)                                         10500878
         CLC   SJBUCK+3(3),SJKOPT       SYSOPT                          10500879
         BCR   8,SJBRRG                 BRANCH EQUAL                    10500880
         LA    SJW4RG,4(SJW4RG)                                         10500881
         CLC   SJBUCK+3(3),SJKLOG       SYSLOG                          10500882
         BCR   8,SJBRRG                 BRANCH EQUAL                    10500883
         CLI   SJBUCK+5,C' '                                            10500884
         BE    SJCCER                                                   10500885
         TM    SJBUCK+3,X'F0'           TEST FOR NON NUMERIC ERROR      10500886
         BC    14,SJCCER                                                10500887
         TM    SJBUCK+4,X'F0'                                           10500888
         BC    14,SJCCER                                                10500889
         TM    SJBUCK+5,X'F0'                                           10500890
         BC    14,SJCCER                                                10500891
         PACK  SJBCK1(8),SJBUCK+3(3)    PACK INTO FULL WORD             10500892
         CVB   SJW1RG,SJBCK1            CONV PUB NO TO BINARY           10500893
         LA    SJW1RG,1(SJW1RG)        ALLOW FOR PUB 000                10500894
         STC   SJW1RG,SJSYS1+1                                          10500895
         LH    SJW2RG,22                LOAD PUB ADDR IN WORK REG       10500896
SJSYS1   CLI   3(SJW2RG),X'00'          IS THIS PUB IN THIS SYSTEM      10500897
         BL    SJCCER                                                   10500898
         SLL   SJW1RG,2                 MULT PUB NO BY 4                10500899
         AR    SJW4RG,SJW1RG            ADD PUB DISP TO TABLE REG       10500900
         BR    SJBRRG                                                   10500901
SJASGN   BALR  SJLKRG,SJSBRG            SKIP BLANKS AFTER VERB          10500902
         BAL   SJBRRG,SJSYSR                                            10500903
         AH    SJW4RG,22                                                10500904
SJASG2   BAL   SJLKRG,SJFLBK                                            10500905
         XC    SJPUB(4),SJPUB                                           10500906
         CLC   SJBUCK(3),SJKUA         SHOULD PUB BE UNASSIGNED         10500907
         BE    SJASG5                  LOAD EMPTY PUB                   10500908
         CLC   SJBUCK+5(2),SJKQB        TEST IF PAR2 IS X'XXX'          10500909
         BNE   SJCCER                                                   10500910
         CLC   SJBUCK(2),SJKHEX                                         10500911
         BNE   SJCCER                                                   10500912
         CLI   SJBUCK+2,C'2'            IS CHAN GREATER THAN 2          10500913
         BH    SJCCER                                                   10500914
         MVC   SJPUB(1),SJBUCK+2        STORE CHAN IN TEMP PUB          10500915
         NI    SJPUB,X'0F'              CONV CHAN NUMBER TO BINARY      10500916
         MVC   SJBCK1(2),SJBUCK+3       PLACE HEX CHARS IN BUCKET       10500917
         BAL   SJLKRG,SJCVHB            GO TO CONV HEX TO BINARY ROUTIN 10500918
         STC   SJW2RG,SJPUB+1           STORE UNIT NO IN TEMP PUB       10500919
         BAL   SJLKRG,SJFLBK                                            10500920
         CLI   SJBUCK+2,C' '            TEST IF PARAM IS MORE THAN 2CH  10500921
         BNE   SJCCER                                                   10500922
         LA    SJTBRG,SJDTAB            SET TABLE REG TO DEVICE TAB     10500923
         LA    SJCTRG,12                                                10500924
SJASG3   CLC   SJBUCK(2),1(SJTBRG)      COMPARE TABLE ENTRY TO DEV TYPE 10500925
         BE    SJASG4                                                   10500926
         LA    SJTBRG,3(SJTBRG)         INCR TO NEXT TABLE ENTRY        10500927
         BCT   SJCTRG,SJASG3            LOOP TILL END OF TABLE          10500928
         B     SJCCER                                                   10500929
SJASG4   MVC   SJPUB+2(1),0(SJTBRG)     STORE CODE IN PUB               10500930
         CLI   0(SJCCRG),C' '           IS THERE A PARAM4               10500931
         BE    SJASG5                                                   10500932
         BALR  SJLKRG,SJFBRG            MOVE PARAM4 TO BUCKET           10500933
         CLC   SJBUCK(2),SJKHEX         TEST IF PAR4 IS X'XX'           10500934
         BNE   SJCCER                                                   10500935
         CLC   SJBUCK+4(2),SJKQB                                        10500936
         BNE   SJCCER                                                   10500937
         MVC   SJBCK1(2),SJBUCK+2       PLACE HEX CHARS IN BUCKET       10500938
         BAL   SJLKRG,SJCVHB            CONVERT HEX TO BINARY           10500939
         STC   SJW2RG,SJPUB+3           STORE ANS.IN TEMP PUB           10500940
SJASG5   MVC   0(4,SJW4RG),SJPUB        MOVE NEW ASSIGNMENT TO PUB      10500941
         B     SJREAD                                                   10500942
SJCVHB   LA    SJW1RG,SJBCK1+1          POINT REG TO 2ND HEX CHAR       10500943
         LA    SJCTRG,2                 SET COUNTER TO 2                10500944
SJCHBA   SR    SJW2RG,SJW2RG            ZERO WORK REGISTER              10500945
         IC    SJW2RG,0(SJW1RG)         PUT HEX CHAR IN WORK REG        10500946
         TM    0(SJW1RG),X'F0'          IS IT 1111XXXX                  10500947
         BC    14,SJCHB1                BRANCH IF NOT 1111XXXX          10500948
         B     SJCHB2                                                   10500949
SJCHB1   LA    SJW2RG,09(SJW2RG)                                        10500950
         CLI   0(SJW1RG),C'F'                                           10500951
         BH    SJCCER                                                   10500952
         CLI   0(SJW1RG),C'A'                                           10500953
         BL    SJCCER                                                   10500954
SJCHB2   SRDL  SJW2RG,4                 SHIFT GOOD BITS TO ADJACENT REG 10500955
         BCTR  SJW1RG,0                 POINT REG TO 1ST HEX CHAR       10500956
         BCT   SJCTRG,SJCHBA            LOOP ONCE                       10500957
         SLDL  SJW2RG,8            SHIFT BINARY BYTE TO REG FOR STC     10500958
         BR    SJLKRG                                                   10500959
SJNOJC   MVC   SJMESG+3(3),SJNJCM       MOVE MESSAGE FOR NO JOB CARD    10500960
         B     SJMESG                                                   10500961
SJNOSL   MVC   SJMESG+3(3),SJMSG3                                       10500962
         B     SJNOCC+6                                                 10500963
SJNOCC   TM    SJCRJB(SJCRRG),X'02'                                     10500964
         BZ    SJREAD                                                   10500965
         MVC   SJMESG+3(3),SJMSG2                                       10500966
         B     SJMESG                                                   10500967
SJCCER   MVI   SJMESG+3,C'3'            CONTROL CARD ERROR              10500968
         STH   0,SJMESG+4                                               10500969
         OC    SJMESG+4(2),SJK5F0                                       10500970
SJMESG   SVC   2                        TELL SUPV TO DISPLAY MESSAGE    10500971
         DC    C'1   '                  MESSAGE TO BE DISPLAYED         10500972
         DC    C'A'                    RESPONSE REQUESTED               10500973
         DC    C' '                     RESPONSE CHARACTER-NOT USED     10500974
         B     SJREAD        READ NEXT CARD                             10500975
SJLOG    TM    SJCRJB(SJCRRG),X'80'          TEST LOG FLAG              10500976
         BC    1,SJREAD                      IF ON EXIT                 10500977
         OI    SJCRJB(SJCRRG),X'80'          SET LOG FLAG ON            10500978
         BAL   SJLKRG,SJDISP                                            10500979
         B     SJREAD                                                   10500980
SJNLOG   NI    SJCRJB(SJCRRG),X'7F'          RESET LOG FLAG             10500981
         B     SJREAD                                                   10500982
SJDISP   TM    SJCRJB(SJCRRG),X'80'          TEST LOG SW                10500983
         BCR   14,SJLKRG                     EXIT IF OFF                10500984
*   SCAN CARD FROM COL 80 FOR NON-BLANK ,COMPUTE LENGTH FOR CCW         10500985
         LA    SJCCRG,SJINPT+79        COMPUTE LENGTH FOR DISPLAYING    10500986
SJDSP1   CLI   0(SJCCRG),C' '                                           10500987
         BNE   SJDSP2                                                   10500988
         BCT   SJCCRG,SJDSP1                                            10500989
SJDSP2   SH    SJCCRG,SJAIPT                                            10500990
         STH   SJCCRG,SJDCCW+6                                          10500991
         SVC   0                                                        10500992
         DC    YL2(SJDCCB)                                              10500993
         TM    SJDCCB+2,X'80'                                           10500994
         BC    8,*-4                                                    10500995
         BR    SJLKRG                                                   10500996
SJAIPT   DC    YL2(SJINPT-1)                                            10500997
SJFILE   BALR  SJLKRG,SJSBRG                                            10500998
         BAL   SJBRRG,SJSYSR                                            10500999
         STC   SJW1RG,SJTCCB+5               STORE PUB DISP IN CCB      10501000
         CLI   2(SJW2RG),X'00'               TEST FOR TAPE ASSGN IN PUB 10501001
         BNE   SJCCER                                                   10501002
         BALR  SJLKRG,SJFBRG                 GET 2ND PARAMETER          10501003
         CLC   SJBUCK(2),SJKHEX              TEST FORMAT- MUST BE X'HH' 10501004
         BNE   SJCCER                                                   10501005
         CLC   SJBUCK+4(2),SJKQB                                        10501006
         BNE   SJCCER                                                   10501007
         MVC   SJBCK1(2),SJBUCK+2            INIT FOR CONVERSION ROUT   10501008
         BAL   SJLKRG,SJCVHB                 CONVERT HEX TO BINARY      10501009
* RESULT IS IN SJW2RG.THIS WILL BE THE COUNT REG IN SKIP TAPE ROUTINE   10501010
SJSKTP   SVC   0                             SKIP TAPE TO A TAPE MARK   10501011
         DC    YL2(SJTCCB)                                              10501012
         TM    SJTCCB+2,X'80'                                           10501013
         BC    8,*-4                                                    10501014
         BCT   SJW1RG,SJSKTP                 LOOP TILL COUNT OF ZERO    10501015
         B     SJREAD                        EXIT                       10501016
SJREST   BALR  SJLKRG,SJSBRG                                            10501017
         BALR  SJLKRG,SJFBRG                 GET FIRST PARAM            10501018
         BAL   SJBRRG,SJSYSR+2               CONV SYSXXX TO A DISP      10501019
SJRS1    STH   SJW4RG,12(SJCRRG)             STORE DISP IN 2 USER BYTES 10501020
         BALR  SJLKRG,SJFBRG                 GET CHECKPOINT IDENTIFIER  10501021
         CLI   SJBUCK+4,C' '                                            10501022
         BNE   SJCCER                                                   10501023
         MVC  14(4,SJCRRG),SJBUCK            STORE IDEN IN USER BYTES   10501024
         OI    SJCRJB(SJCRRG),X'08'          SET RESTART FLAG ON        10501025
         B     SJREAD                                                   10501026
SJECCB   DC    X'002080000014'          EOJ CCB                         10501027
         DC    YL2(SJECCW)                                              10501028
SJECCW   CCW   9,SJEOJM,X'20',12                                        10501029
SJTCCB   DC    X'000010000018'         TAPE CCB                         10501030
         DC    YL2(SJTCCW)                                              10501031
SJTCCW   CCW   X'3F',SJINPT,X'20',1                                     10501032
SJDCCB   DC    X'001180000014'                                          10501033
         DC    YL2(SJDCCW)                                              10501034
SJDCCW   CCW   9,SJINPT,X'20',80                                        10501035
SJCCB    DC    X'000080000004'                                          10501036
         DC    YL2(SJCCW)                                               10501037
SJCCW    CCW   2,SJINPT,X'20',80                                        10501038
SJBCK1   DS    1CL8                                                     10501039
         DS    1CL80                                                    10501040
SJINPT   DS    1CL80                                                    10501041
SJEOB    DC    YL2(SJBUCK+9)            END OF BUCKET ADDRESS           10501042
SJEOC    DC    YL2(SJINPT+70)           END OF CARD ADDRESS             10501043
SJKW3    DC    X'00000003'                                              10501044
SJK008   DC    X'0008'                                                  10501045
SJK01    DC    X'0001'                                                  10501046
SJBUCK   DS    1CL9                                                     10501047
SJKCTL   DC    C'// '                                                   10501048
SJKPAU   DC    C'PAUSE'                                                 10501049
SJKJOB   DC    C'JOB '                                                  10501050
SJDAT    DC    C' '                                                     10501051
SJKSYS   DC    C'SYS'                                                   10501052
SJKRDR   DC    C'RDR'                                                   10501053
SJKLST   DC    C'LST'                                                   10501054
SJKIPT   DC    C'IPT'                                                   10501055
SJKOPT   DC    C'OPT'                                                   10501056
SJKLOG   DC    C'LOG '                                                  10501057
SJKNLG   DC    C'NOLOG'                                                 10501058
SJPUB    DC    C'    '                  TEMP PUB ENTRY                  10501059
SJ9BLK   DC    C'         '            9 BLANKS                         10501060
SJNJCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10501061
         DC    C'40'                       FOR NO JOB CARD              10501062
SJNDCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10501063
         DC    C'50'                       FOR NO DATE CARD             10501064
SJMSG1   DC    C'110'                   MESSAGE FOR DUP JOB CARDS       10501065
SJMSG2   DC    C'220'                   CONTROL CARD ERROR MESS175      10501066
SJMSG3   DC    C'200'                  ERROR MESSAGE FOR NO //          10501067
SJPMSG   DC    C'703A '                      PAUSE MESSAGE              10501068
SJDTAB   DC    X'02'                    DEVICE TABLE ENTRIES            10501069
         DC    C'C1'                                                    10501070
         DC    X'06'                                                    10501071
         DC    C'L1'                                                    10501072
         DC    X'12'                                                    10501073
         DC    C'L2'                                                    10501074
         DC    X'0A'                                                    10501075
         DC    C'P1'                                                    10501076
         DC    X'04'                                                    10501077
         DC    C'P2'                                                    10501078
         DC    X'10'                                                    10501079
         DC    C'R0'                                                    10501080
         DC    X'08'                                                    10501081
         DC    C'R1'                                                    10501082
         DC    X'0A'                                                    10501083
         DC    C'R2'                                                    10501084
         DC    X'04'                                                    10501085
         DC    C'R3'                                                    10501086
         DC    X'0E'                                                    10501087
         DC    C'S1'                                                    10501088
         DC    X'00'                                                    10501089
         DC    C'T1'                                                    10501090
         DC    X'00'                                                    10501091
         DC    C'T2'                                                    10501092
SJMOTB   DC    X'1F'                    DAYS IN MONTH TABLE             10501093
SJFEB    DC    X'1C'                                                    10501094
         DC    X'1F'                                                    10501095
         DC    X'1E'                                                    10501096
         DC    X'1F'                                                    10501097
         DC    X'1E'                                                    10501098
         DC    X'1F'                                                    10501099
         DC    X'1F'                                                    10501100
         DC    X'1E'                                                    10501101
         DC    X'1F'                                                    10501102
         DC    X'1E'                                                    10501103
         DC    X'1F'                                                    10501104
SJTABL   DC    YL2(SJDATE)              CONTROL CARD TABLE              10501105
SJKDAT   DC    C'DATE '                                                 10501106
         DC    YL2(SJCONF)                                              10501107
         DC    C'CONFG'                                                 10501108
         DC    YL2(SJVOL)                                               10501109
         DC    C'VOL  '                                                 10501110
         DC    YL2(SJFILE)                                              10501111
         DC    C'FILES'                                                 10501112
         DC    YL2(SJREST)                                              10501113
         DC    C'RSTRT'                                                 10501114
         DC    YL2(SJEXEC)                                              10501115
         DC    C'EXEC '                                                 10501116
         DC    YL2(SJUPSI)                                              10501117
         DC    C'UPSI '                                                 10501118
         DC    YL2(SJASGN)                                              10501119
SJKASG   DC    C'ASSGN'                                                 10501120
SJNUMT   DC    10X'00'                                                  10501121
         DC    C'123456'                                                10501122
SJK5F0   DC    X'F0F0F0F0F0'                                            10501123
SJK50F   DC    X'0F0F0F0F0F'                                            10501124
SJK12    DC    X'F1F2'                                                  10501125
SJKUA    DC    C'UA '                                                   10501126
SJKHEX   DC    CL2'X'''                 CONSTANT X'                     10501127
SJKQB    DC    CL2''' '                 CONSTANT QUOTE-BLANK            10501128
SJKRPG   DC    C'RPG100'                                                10501129
SJKASM   DC    C'ASSEMB'                                                10501130
SJKRES   DC    C'SYSRES'                                                10501131
SJEOJM   DC    C'N EOJ 123456'                                          10501132
*                                                                       10501133
* VOL CARD PROCESSING                                                   10501134
*                                                                       10501135
SJVOL    BALR  SJLKRG,SJSBRG    SKIP BLANKS                             10501136
         BAL   SJW3RG,SJSYSC            CONVERT AND TEST SYSXXX         10501137
         BALR  SJLKRG,SJFBRG            PUT FILE NAME IN BUCKET         10501138
         CLC   SJBUCK(7),SJ9BLK        TEST BLANK FILD                  10501139
         BE    SJLER1                                                   10501140
         MVC   SJLAB(7),SJBUCK         STORE FILE NAME IN LABEL W/A     10501141
         OI    SJNOBR+1,X'F0'                                           10501142
         B     SJREAD                                                   10501143
*       TPLAB CARD INITIAL PROCESSING                                   10501144
SJVOL1   MVI   SJLAB+7,X'00'                                            10501145
         MVC   SJLAB+8(75),SJLAB+7                                      10501146
         LA    SJW3RG,SJLAB+7                                           10501147
         OI    SJLAB3+1,X'F0'                                           10501148
         CLC   SJBUCK(5),SJTLAB         TEST FOR TPLAB CD               10501149
         BC    7,SJNOLC                 BRANCH NOT EQUAL                10501150
*                                                                       10501151
* TPLAB CARD PROCESSING                                                 10501152
*                                                                       10501153
SJTLBP   NI    SJNOBR+1,X'0F'      RESRT SJNOBR SWITCH                  10501154
         BAL   SJBRRG,SJSTRG      PROCESS STRING                        10501155
         B     SJTINU                   BRANCH POINTER FOR CONTINU CARD 10501156
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10501157
SJGOMO   EX    SJW2RG,SJMOV             MOVE LABEL INFOR                10501158
* CHECK -- STRING AT LEAST 49 BYTES                                     10501159
         LA    SJW3RG,0(SJW2RG,SJW3RG)  FIND LENGTH OF STRING           10501160
SJLNCK   CH    SJW3RG,SJTMIN            TEST LENGTH OF STRING           10501161
         BC    4,SJLCER                 BRANCH NEGATINE                 10501162
         BAL   SJBRRG,SJOTD             OUTPUT LABEL REC TO DISK        10501163
         B     SJREAD                   READ NEXT CARD                  10501164
*                                                                       10501165
SJMOV    MVC   0(1,SJW3RG),0(SJW4RG)    MOVE LABEL INFOR TO OUTPUT AREA 10501166
*                                                                       10501167
SJTINU   EX    SJW2RG,SJMOV                                             10501168
         LA    SJW3RG,1(SJW2RG,SJW3RG)  INCR LABEL OUTPUT AREA FILL ADR 10501169
         BAL   SJBRRG,SJRDCN            READ CONTINUATION CARD          10501170
         BAL   SJBRRG,SJSGAG            CONTINU STRING PROCESSING       10501171
         B     SJLCER                   2ND CONTINU IS ERROR            10501172
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10501173
         LA    SJBRRG,1(SJW2RG,SJW3RG)  FORM HI LAB ADDR REQUIRED       10501174
         CH    SJBRRG,SJLBHI            TEST FOR ERRONEOUSLY LONG LABEL 10501175
         BC    4,SJGOMO                 BRANCH LABEL                    10501176
         B     SJLCER                   BRANCH TO ERROR                 10501177
         USING SJLAB2,SJW3RG                                            10501178
SJOTD    LH    SJW3RG,SJLCTR+2                                          10501179
         MVC   SJLAB2(83),SJLAB                                         10501180
         LA    SJW3RG,83(SJW3RG)                                        10501181
         STH   SJW3RG,SJLCTR+2                                          10501182
         DROP  SJW3RG                                                   10501183
         BR    SJBRRG                                                   10501184
SJLCTR   DC    H'0'                                                     10501185
         DC    YL2(SJLAB2)                                              10501186
SJLBKT   DC    X'E000'                                                  10501187
SJKON8   DC    H'8192'                                                  10501188
* STRING PROCESSING ROUTINE                                             10501189
*                                                                       10501190
SJSTRG   OI    SJ2QSW+1,X'F0'           MAKE SURE SWITCH RESET          10501191
         BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10501192
         MVC   SJBUCK(9),SJ9BLK         BLANK SJBUCK                    10501193
         AH    0,SJK01                                                  10501194
         CLI   1(SJCCRG),X'7D'          TEST FOR ' AT START             10501195
         BC    7,SJLCER                 BRANCH NO '                     10501196
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10501197
         LA    SJW4RG,1(SJCCRG)         SAVE START ADDR                 10501198
SJGOON   LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10501199
         CH    SJCCRG,SJEOC             TEST FOR END OF CARD            10501200
         BC    10,SJEOCF                BRANCH NOT NEG                  10501201
         CLI   0(SJCCRG),X'7D'          TEST FOR '                      10501202
         BC    7,SJGOON                 BRANCH NOT EQUAL                10501203
SJQUOT   CLI   1(SJCCRG),X'7D'          TEST FOR 2ND '                  10501204
         BC    7,SJDID                  BRANCH NOT EQUAL                10501205
         LR    SJW2RG,SJCCRG            MOVE CARD COL INDEX             10501206
SJMVUP   BCTR  SJW2RG,0                 DECR TEMPORARY INDEX            10501207
         MVC   1(1,SJW2RG),0(SJW2RG)    MOVE 1 CHAR UP                  10501208
         CLR   SJW4RG,SJW2RG            TEST FOR LAST CHAR              10501209
         BC    10,SJMVUP                BRANCH NOT NEG                  10501210
         LA    SJW4RG,1(SJW4RG)         INCR BEGIN ADDR                 10501211
         LA    SJCCRG,2(SJCCRG)         INCR CARD COL INDEX             10501212
         B     SJGOON                   CONTINUE SCAN                   10501213
*                                                                       10501214
SJDID    LA    SJBRRG,4(SJBRRG)         INCR RETURN PAST USER EOC BRNCH 10501215
SJNDID   LR    SJW2RG,SJCCRG            FIND LENGTH-1 OF STRING         10501216
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10501217
         SR    SJW2RG,SJW4RG                                            10501218
         BCR   13,SJBRRG                RETURN IF LENGTH LENGTH 0       10501219
         BCTR  SJW2RG,0                                                 10501220
         BR    SJBRRG                   RETURN                          10501221
* CONTINUE SCAN ON CONTINUATION CARD                                    10501222
SJSGAG   LA    SJW4RG,1(SJCCRG)         SAVE STRING RESTART ADDR        10501223
SJ2QSW   BC    15,SJGOON                SWITCH TO NORMAL CONTINUATION   10501224
         OI    SJ2QSW+1,X'F0'           RESET SWITCH                    10501225
         B     SJQUOT                   GO TO 2ND QUOT TEST             10501226
*                                                                       10501227
SJEOCF   CLI   0(SJCCRG),X'7D'          END OF CARD OPERATIONS          10501228
         BC    7,SJNAPS                                                 10501229
         CLI   1(SJCCRG),C' '                                           10501230
         BC    8,SJDID                                                  10501231
         NI    SJ2QSW+1,X'0F'                                           10501232
         B     SJNDID                                                   10501233
*                                                                       10501234
SJNAPS   CLI   1(SJCCRG),C' '           TEST FOR CONTINUE               10501235
         BC    8,SJLCER                 BRANCH EQUAL                    10501236
SJNDEC   LR    SJW2RG,SJCCRG            FIND LENGTH-1 SO FAR            10501237
         SR    SJW2RG,SJW4RG                                            10501238
         BR    SJBRRG                                                   10501239
*                                                                       10501240
*                                                                       10501241
* READ CONTINUE CARD AND CHECK 1ST 15 COLS ARE BANK                     10501242
*                                                                       10501243
SJRDCN   BAL   SJLKRG,SJRDCD            READ CARD                       10501244
         CLI   SJINPT,C' '              TEST 1ST 15 COLS BLANK          10501245
         BNE   SJLCER                                                   10501246
         CLC   SJINPT+1(14),SJINPT                                      10501247
         BNE   SJLCER                                                   10501248
         LA    SJCCRG,SJINPT+14         LOAD CONTINUE SCAN ADDR         10501249
         BR    SJBRRG                   RETURN                          10501250
*                                                                       10501251
* SUBROUTINE -- RESET BRANCH SWITCHES                                   10501252
*                                                                       10501253
SJRRST   NI    SJNOBR+1,X'0F'        RESET NOBR SWITCHES                10501254
         BR    SJLKRG                                                   10501255
*                                                                       10501256
* NO LABEL CARD ROUTINE                                                 10501257
SJNOLC   BAL   SJLKRG,SJRRST                                            10501258
SJNLC1   NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL SWITCHES      10501259
         B     SJNOCC+8                 BRANCH TO NO CONTROL CARD       10501260
*ROUTINE FOR ERROR IN LABEL CARD                                        10501261
SJLCER   BAL   SJLKRG,SJRRST                                            10501262
SJLER1   NC    SJCRJB(2,SJCRRG),SJCRRS                                  10501263
         B     SJCCER                                                   10501264
* SUBROUTINE FOR SYSXXX CHECK AND CONVERSION                            10501265
SJSYSC   NI    SJNOBR+1,X'0F'   RESET SWITCHES                          10501266
         MVC   SJSAVS(2),SJCRJB(SJCRRG) SAVE JOB CONTROL BYTES          10501267
         NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL BYTES         10501268
         BALR  SJLKRG,SJSBRG   SKIP BLANKS                              10501269
         BAL   SJBRRG,SJSYSR   CONVERT AND CHECK                        10501270
         OI    SJNOBR+1,X'F0'     RESTORE SWITCHES                      10501271
         MVC   SJCRJB(2,SJCRRG),SJSAVS  RESTORE JOB CONTROL BYTES       10501272
         BR    SJW3RG    RETURN                                         10501273
SJMLAB   SR    SJW2RG,SJW2RG                                            10501274
         LA    SJW1RG,SJLAB2    GET WORK AREA ADD                       10501275
         LH    SJW4RG,SJLCTR+2                                          10501276
         SR    SJW4RG,SJW1RG                                            10501277
         SR    SJW3RG,SJW4RG   GET START ADD                            10501278
         MVI   0(SJW3RG),C'*'  PUT * IN FIRST POS VOL AREA              10501279
         LA    SJW3RG,1(SJW3RG)                                         10501280
SJLAB4   MVC   0(83,SJW3RG),0(SJW1RG)                                   10501281
         LA    SJW2RG,83(SJW2RG)                                        10501282
         LA    SJW1RG,83(SJW1RG)                                        10501283
         CR    SJW2RG,SJW4RG                                            10501284
         BE    SJEXQ6                                                   10501285
         LA    SJW3RG,83(SJW3RG)                                        10501286
         B     SJLAB4                                                   10501287
*  STORAGE AND CONSTANTS                                                10501288
SJLAB    DS    CL85                                                     10501289
SJTLAB   DC    CL5'TPLAB'                                               10501290
SJDECM   EQU   SJBCK1                                                   10501291
SJSAVS   DS    CL2                                                      10501292
SJTMIN   DC    YL2(SJLAB+55)                                            10501293
SJLBHI   DC    YL2(SJLAB+83)                                            10501294
SJCRRS   DC    X'8001'                                                  10501295
SJLAB2   DS    CL85                                                     10501296
         END   START                                                    10501297
         TITLE 'PHASE 1   CARD TO PRINTER/PUNCH'                        10501298
         START 2488                                                     10501299
STRT     BALR  15,0                                                     10501300
         USING *,15                                                     10501301
         BC    15,INPUT                                                 10501302
         ORG   *+6                                                      10501303
SORS     DC    F'1'           STARTING RECORD NUMBER                    10501304
QORS     DC    F'0'           SEQUENCING INFORMATION                    10501305
IRCLN    DC    H'80'          INPUT RECORD LENGTH                       10501306
IBKSZ    DC    H'80'          INPUT BLOCK SIZE                          10501307
ORCLN    DC    H'80'          OUTPUT RECORD LENGTH                      10501308
OBKSZ    DC    H'80'          OUTPUT BLOCK SIZE                         10501309
TPGM     DC    X'18'          PROGRAM TYPE                              10501310
TJOB     DC    X'40'          TYPE OF JOB                               10501311
FRCD     DC    X'01'          RECORD FORMAT                             10501312
DOPTN    DC    X'08'          INPUT AND OUTPUT OPTIONS                  10501313
POPTN    DC    X'11'          PAGING AND SPACING INFORMATION            10501314
LABSW    DC    X'00'                                                    10501315
ICU      DC    X'00'                                                    10501316
OCU      DC    X'00'                                                    10501317
IBKC     DC    F'0'                                                     10501318
OBKC     DC    F'0'                                                     10501319
LABIH    DC    C'**'                                                    10501320
LABOH    DC    C'**'                                                    10501321
LABIT    DC    H'0'                                                     10501322
LABOT    DC    H'0'                                                     10501323
LABOR    DC    H'0'                                                     10501324
AAST     DC    H'0'                                                     10501325
LABRTN   DC    H'4922'                                                  10501326
IPA      DC    X'0C0C'                                                  10501327
OPA      DC    X'1010'                                                  10501328
INA      DC    H'0'                                                     10501329
INB      DC    H'0'                                                     10501330
OUTA     DC    H'0'                                                     10501331
OUTB     DC    H'0'                                                     10501332
UCLIM    DC    H'0'                                                     10501333
SWHD     DC    X'00'                                                    10501334
NOIO     DC    X'00'                                                    10501335
HEAD     DC    CL16'                '                                   10501336
         DC    CL16'                '                                   10501337
         DC    CL16'                '                                   10501338
         DC    CL16'                '                                   10501339
         DC    CL16'                '                                   10501340
         DC    CL16'                '                                   10501341
         DC    CL16'                '                                   10501342
         DC    CL16'                '                                   10501343
         DC    CL16'                '                                   10501344
DSTBL    DC    C'0123456789ABCDEF'                                      10501345
ULAB1    DC    H'0'                                                     10501346
ULAB2    DC    H'0'                                                     10501347
ULAB3    DC    H'0'                                                     10501348
ULAB4    DC    H'0'                                                     10501349
URET     DC    H'0'                                                     10501350
ULAB     DC    H'0'                                                     10501351
USW      DC    X'F0'                                                    10501352
         ORG   SORS+250                                                 10501353
*                                                                       10501354
***   CONTROL CARD INPUT                                                10501355
*                                                                       10501356
INPUT    SVC   0                                                        10501357
         DC    YL2(CCB)                                                 10501358
         TM    CCB+2,X'80'                                              10501359
         BC    8,*-4                                                    10501360
         CLC   HD1(3),CRDAR   IS CONTROL CARD                           10501361
         BC    7,LG1          NO                                        10501362
         CLI   CRDAR+3,C'U'   IS UTILITY MODIFIER CARD                  10501363
         BC    8,UTMF         YES                                       10501364
         CLC   HD2(3),CRDAR+3 IS FIELD SELECT CARD                      10501365
         BC    8,FS           YES                                       10501366
         TM    FSW,X'0F'      IS FIELD SELECT ENFORCED                  10501367
         BC    7,LG3          YES, LOG MESSAGE                          10501368
         CLC   HD3(3),CRDAR+3 IS HEADER CARD NO.1                       10501369
         BC    7,*+12         NO                                        10501370
         OI    SWHD,X'FF'     YES, SET SWHD                             10501371
         BC    15,HD                                                    10501372
         CLC   HD4(3),CRDAR+3 IS HEADER CARD NO.2                       10501373
         BC    7,*+12         NO                                        10501374
         OI    SWHD,X'FF'     YES, SET SWHD                             10501375
         BC    15,HDSD                                                  10501376
         CLC   HD5(3),CRDAR+3 IS END CARD                               10501377
         BC    7,LG6                                                    10501378
LGSW     BC    0,EOJ                                                    10501379
         SVC   1                                                        10501380
         DC    C'SYSLOD'                                                10501381
*                                                                       10501382
***   CONVERSION ROUTINE                                                10501383
*                                                                       10501384
BIN      MVC   BINC+1(1),0(6) SUPPLY ENDING CHARACTER                   10501385
         MVC   CBNN+1(1),0(6)                                           10501386
         LR    3,2            CHECK 4 DIGITS                            10501387
         LA    4,1                                                      10501388
         LA    5,3(2)                                                   10501389
         MVI   *-1,X'03'                                                10501390
LOOP     CLI   0(3),X'F0'                                               10501391
         BCR   4,8                                                      10501392
         CLI   0(3),X'F9'                                               10501393
         BCR   2,8                                                      10501394
         BXH   3,4,CBNN                                                 10501395
BINC     CLI   0(3),C','                                                10501396
         BC    8,*+14                                                   10501397
         BC    15,LOOP                                                  10501398
CBNN     CLI   0(3),C','                                                10501399
         BCR   7,8                                                      10501400
         LR    4,2                                                      10501401
         LA    2,1(3)                                                   10501402
         SR    3,4                                                      10501403
         BCTR  3,0                                                      10501404
         AH    3,N112                                                   10501405
         STC   3,*+5                                                    10501406
         PACK  TEMP(8),0(0,4) CONVERT TO BINARY                         10501407
         CVB   3,TEMP                                                   10501408
         C     3,N64K                                                   10501409
         BC    2,*+12                                                   10501410
         STH   3,0(9)                                                   10501411
         BC    15,2(6)                                                  10501412
         BCTR  2,0                                                      10501413
         BCR   15,8                                                     10501414
*                                                                       10501415
***   ERROR LOGGING ROUTINE                                             10501416
*                                                                       10501417
LG1      LA    5,MSSG1                                                  10501418
         LA    6,15                                                     10501419
         STC   6,LGMVC+1                                                10501420
         BC    15,LG                                                    10501421
LG2      LA    5,MSSG2                                                  10501422
         LA    6,38                                                     10501423
         STC   6,LGMVC+1                                                10501424
         OI    NTSW+1,X'F0'                                             10501425
         BC    15,LG                                                    10501426
LG3      LA    5,MSSG3                                                  10501427
         LA    6,24                                                     10501428
         STC   6,LGMVC+1                                                10501429
         BC    15,LG                                                    10501430
LG4      LA    5,MSSG4                                                  10501431
         LA    6,36                                                     10501432
         STC   6,LGMVC+1                                                10501433
         OI    NTSW+1,X'F0'                                             10501434
         LH    3,NOFS                                                   10501435
         AH    3,N1                                                     10501436
         STH   3,NOFS                                                   10501437
         BC    15,LG                                                    10501438
LG5      LA    5,MSSG5                                                  10501439
         LA    6,29                                                     10501440
         STC   6,LGMVC+1                                                10501441
         BC    15,LG                                                    10501442
LG6      LA    5,MSSG6                                                  10501443
         LA    6,19                                                     10501444
         STC   6,LGMVC+1                                                10501445
LG       XC    LOGAR(39),LOGAR    CLEAR PRINT AREA                      10501446
         LA    6,1(6)                                                   10501447
         STC   6,CCWL+7                                                 10501448
LGMVC    MVC   LOGAR(0),0(5)  MOVE MESSAGE TO PRINT AREA                10501449
         SVC   0             PRINT MSSG                                 10501450
         DC    YL2(CCBL)                                                10501451
         TM    CCBL+2,X'80'                                             10501452
         BC    8,*-4                                                    10501453
         OI    LGSW+1,X'F0'                                             10501454
NTSW     BC    0,NTRTN                                                  10501455
EOJ      SVC   1                                                        10501456
         DC    C'SYSEOJ'                                                10501457
NTRTN    NI    NTSW+1,X'00'                                             10501458
CKSW     BC    0,TPJOB                                                  10501459
CKSW1    BC    0,TPJBS                                                  10501460
         CLI   FSW,X'F0'                                                10501461
         BC    8,FSCK                                                   10501462
RET      LA    2,1(2)                                                   10501463
         CLI   0(2),C','                                                10501464
         BC    7,*+12                                                   10501465
         LA    2,1(2)                                                   10501466
         BC    15,SFSC+12                                               10501467
         CLI   0(2),C' '                                                10501468
         BC    7,RET                                                    10501469
         BC    15,SFS+8                                                 10501470
FSCK     LA    2,1(2)                                                   10501471
         CLI   0(2),C'/'                                                10501472
         BC    7,*+12                                                   10501473
         LA    2,1(2)                                                   10501474
         BC    15,FSIN                                                  10501475
         CLI   0(2),C' '                                                10501476
         BC    7,FSCK                                                   10501477
         BC    15,INPUT                                                 10501478
*                                                                       10501479
***   FINDING TYPE OF PROGRAM                                           10501480
*                                                                       10501481
UTMF     LA    2,CRDAR+4                                                10501482
         CLI   0(2),C' '      IS NEXT BLANK                             10501483
         BC    8,TPJBS        YES, BRANCH TO TPJBS                      10501484
         MVI   MSSG2,C'N'                                               10501485
         OI    CKSW+1,X'F0'                                             10501486
         CLI   0(2),C'C'      IS CARD INPUT                             10501487
         BC    7,*+12         NO, BRANCH TO NEXT                        10501488
         MVI   TPGM,X'10'     YES, SET TPGM                             10501489
         BC    15,OUTD                                                  10501490
         CLI   0(2),C'T'      IS TAPE INPUT                             10501491
         BC    7,*+12         NO, BRANCH TO NEXT                        10501492
         MVI   TPGM,X'20'     YES, SET TPGM                             10501493
         BC    15,OUTD                                                  10501494
         CLI   0(2),C'D'      IS DISK INPUT                             10501495
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10501496
         MVI   TPGM,X'40'     YES, SET TPGM                             10501497
OUTD     CLI   1(2),C'C'      IS CARD OUTPUT                            10501498
         BC    7,*+12         NO, BRANCH TO NEXT                        10501499
         OI    TPGM,X'01'     YES, SET TPGM                             10501500
         BC    15,TPJOB                                                 10501501
         CLI   1(2),C'T'      IS TAPE OUTPUT                            10501502
         BC    7,*+12         NO, BRANCH TO NEXT                        10501503
         OI    TPGM,X'02'     YES, SET TPGM                             10501504
         BC    15,TPJOB                                                 10501505
         CLI   1(2),C'D'      IS DISK OUTPUT                            10501506
         BC    7,*+12         NO, BRANCH TO NEXT                        10501507
         OI    TPGM,X'04'     YES, SET TPGM                             10501508
         BC    15,TPJOB                                                 10501509
         CLI   1(2),C'P'      IS PRINT OUTPUT                           10501510
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10501511
         OI    TPGM,X'08'     YES, SET TPGM                             10501512
*                                                                       10501513
***   FINDING TYPE OF JOB                                               10501514
*                                                                       10501515
TPJOB    NI    CKSW+1,X'00'                                             10501516
         OI    CKSW1+1,X'F0'                                            10501517
         LA    2,2(2)                                                   10501518
         CLI   0(2),C' '      IS NEXT BLANK                             10501519
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501520
TPJBS    NI    CKSW1+1,X'00'                                            10501521
         MVI   MSSG2,C'T'                                               10501522
         CLI   1(2),C'T'      IS TYPE DEFINED                           10501523
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501524
         MVI   MSSG2,C'J'                                               10501525
         LA    2,2(2)                                                   10501526
         CLI   0(2),C'C'      IS COPY                                   10501527
         BC    7,*+12         NO, BRANCH TO NEXT                        10501528
         MVI   TJOB,X'01'     YES, SET TJOB                             10501529
         BC    15,SFSC                                                  10501530
         CLI   0(2),C'F'      IS FIELD SELECT                           10501531
         BC    7,*+16         NO, BRANCH TO NEXT                        10501532
         MVI   TJOB,X'02'     YES, SET TJOB                             10501533
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10501534
         BC    15,SFSC                                                  10501535
         CLI   0(2),C'R'      IS REBLOCK                                10501536
         BC    7,EDD          NO, BRANCH TO NEXT                        10501537
         CLI   1(2),C'F'      IS REBLOCK AND FIELD SELECT               10501538
         BC    7,*+20         NO                                        10501539
         MVI   TJOB,X'08'     YES, SET TJOB                             10501540
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10501541
         LA    2,1(2)                                                   10501542
         BC    15,SFSC                                                  10501543
         MVI   TJOB,X'04'     SET TJOB                                  10501544
         BC    15,SFSC                                                  10501545
EDD      CLI   0(2),C'D'      IS DATA DISPLAY                           10501546
         BC    7,*+12         NO, BRANCH TO NEXT                        10501547
         MVI   TJOB,X'10'     YES, SET TJOB                             10501548
         BC    15,SFSC                                                  10501549
         CLI   0(2),C'L'      IS LIST                                   10501550
         BC    7,EB           NO, BRANCH TO EB                          10501551
         CLI   1(2),C'F'      IS LIST AND FIELD SELECT                  10501552
         BC    7,*+20         NO                                        10501553
         MVI   TJOB,X'00'     YES, SET TJOB                             10501554
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10501555
         LA    2,1(2)                                                   10501556
         BC    15,SFSC                                                  10501557
         MVI   TJOB,X'20'     SET TJOB                                  10501558
         BC    15,SFSC                                                  10501559
EB       CLI   0(2),C'B'      IS BOTH                                   10501560
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501561
         CLI   1(2),C'F'      IS BOTH WITH FIELD SELECT                 10501562
         BC    7,*+20         NO                                        10501563
         MVI   TJOB,X'80'     YES, SET TJOB                             10501564
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10501565
         LA    2,1(2)                                                   10501566
         BC    15,SFSC                                                  10501567
         MVI   TJOB,X'40'     SET TJOB                                  10501568
         BC    15,SFSC                                                  10501569
*                                                                       10501570
***   ENTRANCE TO SEARCH OF PARAMETERS                                  10501571
*                                                                       10501572
SFS      CLI   1(2),C' '      IS BLANK                                  10501573
         BC    7,SFSC         NO, BRANCH TO SFSC                        10501574
         BC    0,INPUT                                                  10501575
         OI    *-3,X'F0'                                                10501576
         MVI   MSSG2,C'M'                                               10501577
         CLI   REQPA,X'07'    GOT ALL REQUIRED PARAMETERS               10501578
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501579
         BC    15,INPUT       YES, READ NEXT CARD                       10501580
SFSC     CLI   1(2),C','      IS COMMA                                  10501581
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501582
         LA    2,2(2)                                                   10501583
*                                                                       10501584
***   RECORD FORMAT PARAMETER                                           10501585
*                                                                       10501586
         CLI   0(2),C'F'      IS FORMAT DEFINED                         10501587
         BC    7,INF          NO, BRANCH TO INF                         10501588
         NI    FRCD,X'F0'                                               10501589
         LA    2,1(2)                                                   10501590
         OI    REQPA,X'01'    YES, MODIFY REQPA                         10501591
         MVI   MSSG2,C'F'                                               10501592
         CLI   0(2),C'F'      IS F-PARAMETER                            10501593
         BC    7,*+12         NO, BRANCH TO NEXT                        10501594
         OI    FRCD,X'01'     YES, MODIFY FRCD                          10501595
         BC    15,SFS                                                   10501596
         CLI   0(2),C'V'      IS V-PARAMETER                            10501597
         BC    7,*+12         NO, BRANCH TO NEXT                        10501598
         OI    FRCD,X'02'     YES, MODIFY FRCD                          10501599
         BC    15,SFS                                                   10501600
         CLI   0(2),C'U'      IS U-PARAMETER                            10501601
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501602
         OI    FRCD,X'04'     YES, MODIFY FRCD                          10501603
         BC    15,SFS                                                   10501604
*                                                                       10501605
***   A-PARAMETER                                                       10501606
*                                                                       10501607
INF      CLC   0(3,2),HD6     IS A-PARAMETER                            10501608
         BC    7,OUTF         NO, BRANCH TO OUTF                        10501609
         OI    REQPA,X'02'    YES, MODIFY REQPA                         10501610
         MVI   MSSG2,C'A'                                               10501611
         LA    2,3(2)                                                   10501612
         TM    FRCD,X'01'     IS FIXED                                  10501613
         BC    8,LICB         NO, BRANCH TO LICB                        10501614
         CLC   0(2,2),HD7     IS 'K='                                   10501615
         BC    7,ULFT         NO, BRANCH TO ULFT                        10501616
         OI    FRCD,X'10'     YES, MODIFY FRCD                          10501617
         LA    2,2(2)                                                   10501618
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10501619
         LA    9,IRCLN        AND STORE IN IRCLN                        10501620
         BAL   6,BIN                                                    10501621
         DC    C', '                                                    10501622
         CLC   0(2,2),HD8     IS 'D='                                   10501623
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501624
         LA    2,2(2)                                                   10501625
         BC    15,LICB                                                  10501626
ULFT     LA    8,LG2          CONVERT DIGITS TO BINARY                  10501627
         LA    9,IRCLN        AND STORE IN IRCLN                        10501628
         BAL   6,BIN                                                    10501629
         DC    C', '                                                    10501630
LICB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10501631
         LA    9,IBKSZ        AND STORE IN IBKSZ                        10501632
         MVI   LOOP-5,X'04'                                             10501633
         BAL   6,BIN                                                    10501634
         DC    C') '                                                    10501635
         TM    FRCD,X'01'     IS FIXED                                  10501636
         BC    1,*+10         YES                                       10501637
         MVC   IRCLN(2),IBKSZ NO, DEFINE INPUT RECORD LENGTH            10501638
         BCTR  2,0                                                      10501639
         BC    15,SFS                                                   10501640
*                                                                       10501641
***   B-PARAMETER                                                       10501642
*                                                                       10501643
OUTF     CLC   0(3,2),HD9     IS B-PARAMETER                            10501644
         BC    7,IPAR         NO, BRANCH TO IPAR                        10501645
         OI    REQPA,X'04'    YES, MODIFY REQPA                         10501646
         MVI   MSSG2,C'B'                                               10501647
         LA    2,3(2)                                                   10501648
         TM    FRCD,X'01'     IS FIXED                                  10501649
         BC    8,LOCB         NO, BRANCH TO LOCB                        10501650
         CLC   0(2,2),HD7     IS 'K='                                   10501651
         BC    8,LCHS         YES, BRANCH TO LCHS                       10501652
         LR    3,2                                                      10501653
         LA    4,1                                                      10501654
         LA    5,3(2)                                                   10501655
LOOP1    CLI   0(3),X'F0'                                               10501656
         BC    4,LG2                                                    10501657
         CLI   0(3),X'F9'                                               10501658
         BC    2,LG2                                                    10501659
         BXH   3,4,CBNN1                                                10501660
         CLI   0(3),C','                                                10501661
         BC    8,CNQ1                                                   10501662
         CLI   0(3),C')'                                                10501663
         BC    7,LOOP1                                                  10501664
         OI    LABSW,X'01'                                              10501665
         BC    15,LOCB                                                  10501666
CBNN1    CLI   0(3),C','                                                10501667
         BC    8,CNQ1                                                   10501668
         CLI   0(3),C')'                                                10501669
         BC    7,LG2                                                    10501670
         OI    LABSW,X'01'                                              10501671
         BC    15,LOCB                                                  10501672
CNQ1     LR    5,2                                                      10501673
         LA    2,1(3)                                                   10501674
         BCTR  3,0                                                      10501675
         SR    3,5                                                      10501676
         AH    3,N112                                                   10501677
         STC   3,*+5                                                    10501678
         PACK  TEMP(8),0(0,5)                                           10501679
         CVB   3,TEMP                                                   10501680
         STH   3,ORCLN                                                  10501681
LOCB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10501682
         LA    9,OBKSZ        AND STORE IN OBKSZ                        10501683
         MVI   LOOP-5,X'04'                                             10501684
         BAL   6,BIN                                                    10501685
         DC    C') '                                                    10501686
         BCTR  2,0                                                      10501687
         TM    FRCD,X'01'                                               10501688
         BC    8,*+16                                                   10501689
         TM    LABSW,X'01'                                              10501690
         BC    1,SORL                                                   10501691
         BC    15,SFS                                                   10501692
SORL     MVC   ORCLN(2),OBKSZ YES, DEFINE OUTPUT RECORD LENGTH          10501693
         BC    15,SFS                                                   10501694
LCHS     OI    FRCD,X'20'     MODIFY FRCD                               10501695
         LA    2,2(2)                                                   10501696
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10501697
         LA    9,ORCLN        AND STORE IN ORCLN                        10501698
         BAL   6,BIN                                                    10501699
         DC    C', '                                                    10501700
         CLC   0(2,2),HD8     IS 'D='                                   10501701
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501702
         LA    2,2(2)                                                   10501703
         BC    15,LOCB                                                  10501704
*                                                                       10501705
***   I-PARAMETER                                                       10501706
*                                                                       10501707
IPAR     CLI   0(2),C'I'      IS I-PARAMETER                            10501708
         MVI   MSSG2,C'I'                                               10501709
         BC    7,OPAR         NO, BRANCH TO OPAR                        10501710
         NI    DOPTN,X'0F'                                              10501711
         CLI   1(2),C'1'      IS '1'                                    10501712
         BC    7,*+12         NO, BRANCH TO NEXT                        10501713
         OI    DOPTN,X'00'    YES, SET DOPTN                            10501714
         BC    15,TMIP                                                  10501715
         CLI   1(2),C'2'      IS '2'                                    10501716
         BC    8,*+12         YES                                       10501717
         CLI   1(2),C'M'      IS 'M'                                    10501718
         BC    7,*+12         NO, BRANCH TO NEXT                        10501719
         OI    DOPTN,X'10'    YES, SET DOPTN                            10501720
         BC    15,TMIP                                                  10501721
         CLI   1(2),C'U'      IS 'U'                                    10501722
         BC    7,*+12         NO, BRANCH TO NEXT                        10501723
         OI    DOPTN,X'80'    YES, SET DOPTN                            10501724
         BC    15,TMIP                                                  10501725
         CLI   1(2),C'R'      IS 'R'                                    10501726
         BC    7,*+12         NO, BRANCH TO NEXT                        10501727
         OI    DOPTN,X'40'    YES, SET DOPTN                            10501728
         BC    15,TMIP                                                  10501729
         CLI   1(2),C'N'      IS 'N'                                    10501730
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501731
         OI    DOPTN,X'20'    YES, SET DOPTN                            10501732
TMIP     LA    2,1(2)                                                   10501733
         BC    15,SFS                                                   10501734
*                                                                       10501735
***   O-PARAMETER                                                       10501736
*                                                                       10501737
OPAR     CLI   0(2),C'O'      IS O-PARAMETER                            10501738
         BC    7,SPAR         NO, BRANCH TO SPAR                        10501739
         MVI   MSSG2,C'O'                                               10501740
         NI    DOPTN,X'F0'                                              10501741
         CLI   1(2),C'1'      IS '1'                                    10501742
         BC    7,*+12         NO, BRANCH TO NEXT                        10501743
         OI    DOPTN,X'00'    YES, SET DOPTN                            10501744
         BC    15,TMOP                                                  10501745
         CLI   1(2),C'2'      IS '2'                                    10501746
         BC    8,*+12                                                   10501747
         CLI   1(2),C'Y'      NO, IS 'Y'                                10501748
         BC    7,*+12         NO, BRANCH TO NEXT                        10501749
         OI    DOPTN,X'01'    YES, SET DOPTN                            10501750
         BC    15,TMOP                                                  10501751
         CLI   1(2),C'U'      IS 'U'                                    10501752
         BC    8,*+12                                                   10501753
         CLI   1(2),C'C'      NO, IS 'C'                                10501754
         BC    7,*+12         NO, BRANCH TO NEXT                        10501755
         OI    DOPTN,X'08'    YES, SET DOPTN                            10501756
         BC    15,TMOP                                                  10501757
         CLI   1(2),C'R'      IS 'R'                                    10501758
         BC    8,*+12                                                   10501759
         CLI   1(2),C'X'      NO, IS 'X'                                10501760
         BC    7,*+12         NO, BRANCH TO NEXT                        10501761
         OI    DOPTN,X'04'    YES, SET DOPTN                            10501762
         BC    15,TMOP                                                  10501763
         CLI   1(2),C'N'      IS 'N'                                    10501764
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501765
         OI    DOPTN,X'02'    YES, SET DOPTN                            10501766
TMOP     LA    2,1(2)                                                   10501767
         BC    15,SFS                                                   10501768
*                                                                       10501769
***   S-PARAMETER                                                       10501770
*                                                                       10501771
SPAR     CLI   0(2),C'S'      IS S-PARAMETER                            10501772
         BC    7,PPAR         NO, BRANCH TO PPAR                        10501773
         MVI   MSSG2,C'S'                                               10501774
         NI    POPTN,X'0F'                                              10501775
         CLI   1(2),C'1'      IS '1'                                    10501776
         BC    7,*+12         NO, BRANCH TO NEXT                        10501777
         OI    POPTN,X'10'    YES, SET POPTN                            10501778
         BC    15,TMSP                                                  10501779
         CLI   1(2),C'2'      IS '2'                                    10501780
         BC    7,*+12         NO, BRANCH TO NEXT                        10501781
         OI    POPTN,X'20'    YES, SET POPTN                            10501782
         BC    15,TMSP                                                  10501783
         CLI   1(2),C'3'      IS '3'                                    10501784
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501785
         OI    POPTN,X'40'    YES, SET POPTN                            10501786
TMSP     LA    2,1(2)                                                   10501787
         BC    15,SFS                                                   10501788
*                                                                       10501789
***   P-PARAMETER                                                       10501790
*                                                                       10501791
PPAR     CLI   0(2),C'P'      IS P-PARAMETER                            10501792
         BC    7,RPAR         NO, BRANCH TO RPAR                        10501793
         MVI   MSSG2,C'P'                                               10501794
         NI    POPTN,X'F0'                                              10501795
         CLI   1(2),C'Y'      IS 'Y'                                    10501796
         BC    7,*+12         NO, BRANCH TO NEXT                        10501797
         OI    POPTN,X'01'    YES, SET POPTN                            10501798
         BC    15,TMPP                                                  10501799
         CLI   1(2),C'N'      IS 'N'                                    10501800
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501801
         OI    POPTN,X'02'    YES, SET POPTN                            10501802
TMPP     LA    2,1(2)                                                   10501803
         BC    15,SFS                                                   10501804
*                                                                       10501805
***   R-PARAMETER                                                       10501806
*                                                                       10501807
RPAR     CLI   0(2),C'R'     IS R-PARAMETER                             10501808
         BC    7,QPAR         NO, BRANCH TO QPAR                        10501809
         MVI   MSSG2,C'R'                                               10501810
         LA    2,1(2)         CHECK DIGITS                              10501811
         LR    3,2                                                      10501812
         LA    4,1                                                      10501813
         LA    5,7(2)                                                   10501814
LP1      CLI   0(3),X'F0'                                               10501815
         BC    4,LG2                                                    10501816
         CLI   0(3),X'F9'                                               10501817
         BC    2,LG2                                                    10501818
         BXH   3,4,CBIN1                                                10501819
         CLI   0(3),C','                                                10501820
         BC    8,CBIN1+16                                               10501821
         CLI   0(3),C' '                                                10501822
         BC    7,LP1                                                    10501823
         BC    8,CBIN1+16                                               10501824
CBIN1    CLI   0(3),C','                                                10501825
         BC    8,*+12                                                   10501826
         CLI   0(3),C' '                                                10501827
         BC    7,LG2                                                    10501828
         LR    5,2            CONVERT TO BINARY AND STORE IT TO SORS    10501829
         BCTR  3,0                                                      10501830
         LR    2,3                                                      10501831
         SR    3,5                                                      10501832
         AH    3,N112                                                   10501833
         STC   3,*+5                                                    10501834
         PACK  TEMP(8),0(0,5)                                           10501835
         CVB   3,TEMP                                                   10501836
         ST    3,SORS                                                   10501837
         BC    15,SFS                                                   10501838
*                                                                       10501839
***   Q-PARAMETER                                                       10501840
*                                                                       10501841
QPAR     CLC   0(3,2),HD11    IS Q-PARAMETER                            10501842
         MVI   MSSG2,C'U'                                               10501843
         BC    7,LG2          NO, ILLEGAL FORMAT                        10501844
         MVI   MSSG2,C'Q'                                               10501845
         LA    2,3(2)         CHECK DIGITS                              10501846
         LR    3,2                                                      10501847
         LA    4,1                                                      10501848
         LA    5,1(2)                                                   10501849
LP2      CLI   0(3),X'F0'                                               10501850
         BC    4,LG2                                                    10501851
         CLI   0(3),X'F9'                                               10501852
         BC    2,LG2                                                    10501853
         BXH   3,4,CBIN2                                                10501854
         CLI   0(3),C','                                                10501855
         BC    7,LP2                                                    10501856
         BC    8,*+12                                                   10501857
CBIN2    CLI   0(3),C','                                                10501858
         BC    7,LG2                                                    10501859
         LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS    10501860
         LR    2,3                                                      10501861
         BCTR  3,0                                                      10501862
         SR    3,5                                                      10501863
         AH    3,N112                                                   10501864
         STC   3,*+5                                                    10501865
         PACK  TEMP(8),0(0,5)                                           10501866
         CVB   3,TEMP                                                   10501867
         STH   3,QORS                                                   10501868
         LA    2,1(2)         CHECK DIGITS                              10501869
         LR    3,2                                                      10501870
         LA    4,1                                                      10501871
         LA    5,1(2)                                                   10501872
LP3      CLI   0(3),X'F0'                                               10501873
         BC    4,LG2                                                    10501874
         CLI   0(3),X'F9'                                               10501875
         BC    2,LG2                                                    10501876
         BXH   3,4,CBIN3                                                10501877
         CLI   0(3),C')'                                                10501878
         BC    8,CNQ                                                    10501879
         BC    7,LP3                                                    10501880
CBIN3    CLI   0(3),C')'                                                10501881
         BC    7,LG2                                                    10501882
CNQ      LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS+2  10501883
         LR    2,3                                                      10501884
         BCTR  3,0                                                      10501885
         SR    3,5                                                      10501886
         AH    3,N112                                                   10501887
         STC   3,*+5                                                    10501888
         PACK  TEMP(8),0(0,5)                                           10501889
         CVB   3,TEMP                                                   10501890
         STH   3,QORS+2                                                 10501891
         BC    15,SFS                                                   10501892
*                                                                       10501893
***   ENTRANCE TO FIELD SELECT CARD                                     10501894
*                                                                       10501895
FS       TM    FSW,X'F0'      IS FIELD SELECT POSSIBLE                  10501896
         BC    8,LG5          NO, UNNECESSARY CARD                      10501897
         LA    2,CRDAR+6                                                10501898
         BC    0,FSIN                                                   10501899
         OI    *-3,X'F0'                                                10501900
         MVI   FSW,X'F0'      CLEAR ENFORCED SWITCH                     10501901
         XC    NOFS(2),NOFS   SET NOFS ZERO                             10501902
         LA    7,NOFS+2       SET REGISTER 7                            10501903
*                                                                       10501904
***   FIELD SELECT CARD                                                 10501905
*                                                                       10501906
FSIN     LH    4,NOFS                                                   10501907
         AH    4,N1                                                     10501908
         CVD   4,TEMP                                                   10501909
         UNPK  MSSG4(3),TEMP+6(2)                                       10501910
         OI    MSSG4+2,X'F0'                                            10501911
         CLC   0(3,2),HD10    IS '(K,'                                  10501912
         BC    7,INKEY        NO, BRANCH TO INKEY                       10501913
         LA    2,3(2)         YES, SET BITS                             10501914
         MVI   0(7),X'80'                                               10501915
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10501916
         LA    9,4(7)         AND STORE IN R7+4                         10501917
         BAL   6,BIN                                                    10501918
         DC    C') '                                                    10501919
         CLI   0(2),C','      IS ','                                    10501920
         BC    7,LG4          NO, ILLEGAL FORMAT                        10501921
         LA    2,1(2)                                                   10501922
         BC    15,*+22        YES                                       10501923
INKEY    MVI   0(7),X'00'                                               10501924
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10501925
         LA    9,4(7)         AND STORE IN R7+4                         10501926
         BAL   6,BIN                                                    10501927
         DC    C', '                                                    10501928
         CLI   0(2),C'('      IS '('                                    10501929
         BC    8,FLDL         YES, BRANCH TO FLDL                       10501930
         NI    0(7),X'9F'     NO, SET BITS                              10501931
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10501932
         LA    9,10(7)        AND STORE IN R7+10                        10501933
         BAL   6,BIN                                                    10501934
         DC    C', '                                                    10501935
         XC    8(2,7),8(7)                                              10501936
         BC    15,FSOUT                                                 10501937
FLDL     CLI   1(2),C'P'      IS 'P'                                    10501938
         BC    7,UCOM         NO, BRANCH TO UCOM                        10501939
         OI    0(7),X'20'     YES, SET BIT                              10501940
         BC    15,PUCOM                                                 10501941
UCOM     CLI   1(2),C'U'      IS 'U'                                    10501942
         BC    7,XCOM         NO, BRANCH TO XCOM                        10501943
         OI    0(7),X'40'     YES, SET BIT                              10501944
PUCOM    CLI   2(2),C','      IS ','                                    10501945
         BC    7,LG4          NO, ILLEGAL FORMAT                        10501946
         LA    2,3(2)                                                   10501947
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10501948
         LA    9,8(7)         AND STORE IN R7+8                         10501949
         BAL   6,BIN                                                    10501950
         DC    C', '                                                    10501951
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10501952
         LA    9,10(7)        AND STORE IN R7+10                        10501953
         BAL   6,BIN                                                    10501954
         DC    C') '                                                    10501955
         BC    15,LFSP                                                  10501956
XCOM     CLI   1(2),C'X'      IS 'X'                                    10501957
         BC    7,LG4          NO, ILLEGAL FORMAT                        10501958
         OI    0(7),X'60'     YES, SET BIT                              10501959
         CLI   2(2),C','      IS ','                                    10501960
         BC    7,LG4          NO, ILLEGAL FORMAT                        10501961
         LA    2,3(2)                                                   10501962
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10501963
         LA    9,10(7)        AND STORE IN R7+10                        10501964
         BAL   6,BIN                                                    10501965
         DC    C') '                                                    10501966
         XC    8(2,7),8(7)                                              10501967
LFSP     CLI   0(2),C','      IS ','                                    10501968
         BC    7,LG4          NO, ILLEGAL FORMAT                        10501969
         LA    2,1(2)                                                   10501970
FSOUT    CLC   0(3,2),HD10    IS '(K,'                                  10501971
         BC    7,ONKEY        NO, BRANCH TO ONKEY                       10501972
         LA    2,3(2)                                                   10501973
         OI    0(7),X'10'     YES, SET BIT                              10501974
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10501975
         LA    9,6(7)         AND STORE IN R7+6                         10501976
         BAL   6,BIN                                                    10501977
         DC    C') '                                                    10501978
         BC    15,INOFS                                                 10501979
ONKEY    LR    3,2                                                      10501980
         LA    4,1                                                      10501981
         LA    5,3(2)                                                   10501982
LOP      CLI   0(3),X'F0'                                               10501983
         BC    4,LG4                                                    10501984
         CLI   0(3),X'F9'                                               10501985
         BC    2,LG4                                                    10501986
         BXH   3,4,CBN                                                  10501987
         CLI   0(3),C'/'                                                10501988
         BC    8,CBN+16                                                 10501989
         CLI   0(3),C' '                                                10501990
         BC    7,LOP                                                    10501991
         BC    8,CBN+16                                                 10501992
CBN      CLI   0(3),C'/'                                                10501993
         BC    8,*+12                                                   10501994
         CLI   0(3),C' '                                                10501995
         BC    7,LG4                                                    10501996
         LR    5,2                                                      10501997
         LR    2,3                                                      10501998
         BCTR  3,0                                                      10501999
         SR    3,5                                                      10502000
         AH    3,N112                                                   10502001
         STC   3,*+5                                                    10502002
         PACK  TEMP(8),0(0,5)                                           10502003
         CVB   3,TEMP                                                   10502004
         STH   3,6(7)                                                   10502005
INOFS    LH    3,NOFS         INCREASE NOFS BY 1                        10502006
         AH    3,N1                                                     10502007
         STH   3,NOFS                                                   10502008
         TM    0(7),X'10'     IS KEY SPECIFIED                          10502009
         AH    7,N12          INCREASE REGISTER 7 BY 12                 10502010
         BC    8,CONT         NO                                        10502011
         CLI   0(2),C'/'      IS '/'                                    10502012
         BC    7,*+12         NO                                        10502013
         LA    2,1(2)                                                   10502014
         BC    15,FSIN        YES, BRANCH TO FSIN                       10502015
         CLI   0(2),C' '      IS BLANK                                  10502016
         BC    7,LG4          NO, ILLEGAL FORMAT                        10502017
         BC    15,INPUT       YES, READ NEXT CARD                       10502018
CONT     CLI   1(2),C'/'      IS '/'                                    10502019
         BCTR  2,0                                                      10502020
         BC    7,INPUT        NO, READ NEXT CARD                        10502021
         LA    2,2(2)                                                   10502022
         BC    15,FSIN                                                  10502023
*                                                                       10502024
***   HEADER CARD                                                       10502025
*                                                                       10502026
HD       MVC   HEAD(74),CRDAR+6    STORE HEADING LINE                   10502027
         BC    15,INPUT                                                 10502028
HDSD     MVC   HEAD+74(70),CRDAR+6 STORE HEADING LINE                   10502029
         BC    15,INPUT                                                 10502030
*                                                                       10502031
***   CONSTANT                                                          10502032
*                                                                       10502033
         CNOP  0,8                                                      10502034
CCB      DC    F'0'                                                     10502035
         DC    X'0004'                                                  10502036
         DC    YL2(CCW)                                                 10502037
CCW      DC    X'02'                                                    10502038
         DC    AL3(CRDAR)                                               10502039
         DC    X'00000050'                                              10502040
CCBL     DC    F'0'                                                     10502041
         DC    X'0014'                                                  10502042
         DC    YL2(CCWL)                                                10502043
CCWL     DC    X'09'                                                    10502044
         DC    AL3(LOGAR)                                               10502045
         DC    X'00000050'                                              10502046
TEMP     DS    D                                                        10502047
N64K     DC    X'0000FFFF'                                              10502048
N1       DC    X'0001'                                                  10502049
N12      DC    X'000C'                                                  10502050
N112     DC    X'0070'                                                  10502051
CRDAR    DS    CL80                                                     10502052
         DC    C' '                                                     10502053
LOGAR    DS    CL39                                                     10502054
FSW      DC    X'00'                                                    10502055
REQPA    DC    X'00'                                                    10502056
HD1      DC    CL3'// '                                                 10502057
HD2      DC    CL3'FS '                                                 10502058
HD3      DC    CL3'H1 '                                                 10502059
HD4      DC    CL3'H2 '                                                 10502060
HD5      DC    CL3'END'                                                 10502061
HD6      DC    CL3'A=('                                                 10502062
HD7      DC    CL2'K='                                                  10502063
HD8      DC    CL2'D='                                                  10502064
HD9      DC    CL3'B=('                                                 10502065
HD10     DC    CL3'(K,'                                                 10502066
HD11     DC    CL3'Q=('                                                 10502067
MSSG1    DC    C'END CARD MISSING'                                      10502068
MSSG2    DC    C'  ILLEGAL FORMAT'                                      10502069
         DC    C'. UTILITY MODIFI'                                      10502070
         DC    C'ER CARD'                                               10502071
MSSG3    DC    C'FIELD SELECT CAR'                                      10502072
         DC    C'D MISSING'                                             10502073
MSSG4    DC    C'    ILLEGAL FORM'                                      10502074
         DC    C'AT. FIELD SELECT'                                      10502075
         DC    C' CARD'                                                 10502076
MSSG5    DC    C'FIELD SELECT CAR'                                      10502077
         DC    C'D NOT EXPECTED'                                        10502078
MSSG6    DC    C'INVALID CONTROL '                                      10502079
         DC    C'CARD'                                                  10502080
         ORG   SORS+4078                                                10502081
NOFS     DS    H                                                        10502082
         END   STRT                                                     10502083
         TITLE 'PHASE 2   CARD TO PRINTER/PUNCH'                        10502084
STAR     START 2752                                                     10502085
START    BALR  15,0                                                     10502086
         USING *,15                                                     10502087
*                                                                       10502088
**** CARD TO PRINT OR PUNCH                                             10502089
*                                                                       10502090
SORS     EQU   2500                                                     10502091
QORS     EQU   2504                                                     10502092
IRCLN    EQU   2508                                                     10502093
IBKSZ    EQU   2510                                                     10502094
ORCLN    EQU   2512                                                     10502095
OBKSZ    EQU   2514                                                     10502096
TPGM     EQU   2516                                                     10502097
TJOB     EQU   2517                                                     10502098
FRCD     EQU   2518                                                     10502099
DOPTN    EQU   2519                                                     10502100
POPTN    EQU   2520                                                     10502101
LABSW    EQU   2521                                                     10502102
ICU      EQU   2522                                                     10502103
OCU      EQU   2523                                                     10502104
IBKC     EQU   2524                                                     10502105
OBKC     EQU   2528                                                     10502106
LABIH    EQU   2532                                                     10502107
LABOH    EQU   2534                                                     10502108
LABIT    EQU   2536                                                     10502109
LABOT    EQU   2538                                                     10502110
LABOR    EQU   2540                                                     10502111
AAST     EQU   2542                                                     10502112
LABRTN   EQU   2544                                                     10502113
IPA      EQU   2546                                                     10502114
OPA      EQU   2548                                                     10502115
INA      EQU   2550                                                     10502116
INB      EQU   2552                                                     10502117
OUTA     EQU   2554                                                     10502118
OUTB     EQU   2556                                                     10502119
UCLIM    EQU   2558                                                     10502120
SWHD     EQU   2560                                                     10502121
NOIO     EQU   2561                                                     10502122
DSTBL    EQU   2706                                                     10502123
       LA    8,ERRTN                    LOAD MESSAGE ADDRESS            10502124
       LA    7,ER00                                                     10502125
       BALR  14,8                       GO PRINT PROGRAM NAME           10502126
         TM    TJOB,X'10'              TYPE DISPLAY                     10502127
         BC    8,*+10                                                   10502128
         MVC   ORCLN(4),DISP           MOVE 120 TO ORCLM AND OBKSZ      10502129
         TM    TJOB,X'DF'              ANYTHING BUT L OR LF             10502130
         BC    5,*+10                                                   10502131
         MVN   DOPTN(1),DISP+1         SET OUTPUT OPTION TO PRINT CHAR  10502132
       LH    11,ZERO                                                    10502133
       TM    LABSW,X'01'                ERROR FROM PHASE 1              10502134
         BC    8,HERE                                                   10502135
         TM    TJOB,X'C3'              B,BF,C,OR F                      10502136
         BC    8,HERE                                                   10502137
       LA    7,ER3                                                      10502138
       BALR  14,8                                                       10502139
HERE   LH    1,20                       GET COMMUNICATION REGION ADDR   10502140
       SR    2,2                        ZERO REG 2                      10502141
       IC    2,9(1)                     GET CONFG BYTE                  10502142
       SRL   2,5                        RIGHT JUSTIFY CONFG BYTE        10502143
       LH    1,ATEK                     8K IN REG 1                     10502144
       SLL   1,0(2)                     MULTIPLY BY(2) TO GET CORE SIZE 10502145
         SH    1,TWO                                                    10502146
       MVC   0(2,1),BRANCH              MOVE BRANCH TO PHASE 4 TO UP CR 10502147
       STH   1,UCLIM                    STORE ADDRESS IN UCLIM          10502148
       TM    TPGM,X'18'                 CARD TO PRINT OR PUNCH          10502149
         BC    1,A1                     YES                             10502150
       LA    7,ER0                      LOAD ADDRESS OF ERROR MESSAGE   10502151
       BALR  14,8                       GO TO ERROR ROUTINE             10502152
A1     LH    1,22                       GET ADDR OF PUB TABLE           10502153
         CLI   14(1),X'08'             1402 READER INPUT                10502154
         BC    8,ZZTT                                                   10502155
         CLI   14(1),X'04'             1442,2520,2501 READER            10502156
         BC    8,ZZTT                                                   10502157
       LA    7,ER1                      NO-LOG ERROR                    10502158
       BALR  14,8                                                       10502159
ZZTT     TM    TJOB,X'03'              COPY OR PUNCH OUTPUT ONLY        10502160
         BC    4,COPFS                 TAKK AWAY PRINT HHAR OPTION      10502161
         CLI   10(1),X'06'              SYSLST 1403 PRINTER             10502162
         BC    8,ZZTT11                                                 10502163
         CLI   10(1),X'12'             SYSLST     1443 PRINTER          10502164
         BC    8,ZZTT11                                                 10502165
       LA    7,ER2                                                      10502166
       BALR  14,8                                                       10502167
ZZTT11   TM    TJOB,X'C0'               B OR BF                         10502168
         BC    8,ZZTT3                                                  10502169
ZZTT1    CLI   18(1),X'0A'             SYSOPT PUNCH 1402                10502170
         BC    8,ZZTT3                                                  10502171
         CLI   18(1),X'04'             SYSOPT 1442,2520,2501            10502172
         BC    8,ZZTT3                                                  10502173
       LA    7,ER2                                                      10502174
       BALR  14,8                                                       10502175
ZZTT3  TM    FRCD,X'01'                 FIXED LENGTH INPUT              10502176
         BC    1,A                      YES                             10502177
       LA    7,ER5                      NO                              10502178
       BALR  14,8                                                       10502179
A      TM    TJOB,X'0C'                 REBLOCK OR RF                   10502180
         BC    8,A2                                                     10502181
       OI    SWIT,X'20'                 SET INVALID PROGRAM TYPE SWITCH 10502182
       LA    7,ER6                      YES -INVALID FOR THIS PROGRAM   10502183
       BALR  14,8                                                       10502184
A2     TM    TJOB,X'C0'                 BOTH OR BOTH AND FIELD SELECT   10502185
         BC    8,A3                     NO                              10502186
       TM    DOPTN,X'01'                YES -OUTPUT BINARY              10502187
         BC    8,A3                     NO - OUTPUT IS NOT BINARY       10502188
       LA    7,ER12                     OUTPUT OPTION INVALID           10502189
       BALR  14,8                                                       10502190
A3     TM    DOPTN,X'10'                INPUT BINARY                    10502191
         BC    8,A4                     NO                              10502192
       CLC   IRCLN(2),ONE60             INPUT RECORD LENGTH OVER 160    10502193
         BC    13,A5                    NO                              10502194
A3A    LA    7,ER7                      YES,ERROR                       10502195
       BALR  14,8                                                       10502196
         BC    15,A5                                                    10502197
A4     CLC   IRCLN(2),EIGHTY            INPT REC LENGTH OVER 80         10502198
         BC    2,A3A                                                    10502199
A5     CLC   IRCLN(2),IBKSZ             INPT REC LEN TO INPT BLOCK SIZE 10502200
         BC    8,A6                                                     10502201
       LA    7,ER8                      INVALID INPUT BLOCK SIZE        10502202
       BALR  14,8                                                       10502203
A6       TM    TJOB,X'CF'              OTHER THN PRINT OUTPUT           10502204
         BC    4,A7                                                     10502205
       CLC   ORCLN(2),ONE44             OUTPUT REC LENGTH OVER 144      10502206
         BC    13,A9                    NO                              10502207
A6A    LA    7,ER9                      YES -ERROR                      10502208
       BALR  14,8                                                       10502209
         BC    15,A9                                                    10502210
A7     TM    DOPTN,X'01'                OUTPUT BINARY                   10502211
         BC    8,A8                     NO                              10502212
       CLC   ORCLN(2),ONE60             OUTPUT REC LENGTH OVER 160      10502213
         BC    13,A9                                                    10502214
         BC    15,A6A                                                   10502215
A8     CLC   ORCLN(2),EIGHTY            OUTPUT REC LENGTH OVER 80       10502216
         BC    2,A6A                                                    10502217
A9     CLC   ORCLN(2),OBKSZ             OPT REC LEN EQUAL OPT BLOCK SIZ 10502218
         BC    8,A10                    YES                             10502219
       LA    7,ER10                     NO- ERROR                       10502220
       BALR  14,8                                                       10502221
A10    CLC   IRCLN(2),ORCLN             INPUT REC LEN VS OUTPUT REC LEN 10502222
         BC    8,A11                                                    10502223
         BC    4,TEDDY                                                  10502224
         TM    TJOB,X'61'              BOTH,LIST,OR COPY                10502225
         BC    8,A11                                                    10502226
         BC    15,LALA                                                  10502227
TEDDY    TM    TJOB,X'4D'              B,C,R,OR RF                      10502228
         BC    8,A11                   YES                              10502229
LALA     LA    7,ER26                                                   10502230
       BALR  14,8                                                       10502231
A11      LH    1,QORS+2                                                 10502232
       CH    1,TEN                                                      10502233
         BC    13,A12                                                   10502234
A11A   LA    7,ER13                     INVALID CARD SEQUENCE           10502235
       BALR  14,8                                                       10502236
         BC    15,A13                                                   10502237
A12    AH    1,QORS                                                     10502238
         BCTR  1,0                                                      10502239
       CH    1,EIGHTY                                                   10502240
         BC    2,A11A                                                   10502241
A13    TM    DOPTN,X'E0'                VALID INPUT OPTION              10502242
         BC    8,A14                                                    10502243
         OI    SWIT,X'02'              INVALID INPUT OPTION SWITCH      10502244
       LA    7,ER11                     INVALID INPUT OPTION            10502245
       BALR  14,8                                                       10502246
A14      TM    TJOB,X'03'              ONLY PUNCH OUTPUT                10502247
         BC    4,A15                   YES                              10502248
         TM    TJOB,X'C0'              BOTH OR BOTH & FIELD SELECT      10502249
         BC    4,ABC                   YES                              10502250
         TM    TJOB,X'10'              DATA DISPLAY                     10502251
         BC    1,TESTR                                                  10502252
         TM    DOPTN,X'08'             OUTPUT CHARACTER                 10502253
         BC    1,RP                                                     10502254
         BC    15,LADD                                                  10502255
TESTR    TM    DOPTN,X'0C'             OUTPUT HEX OR CHARACTER          10502256
         BC    4,RP                                                     10502257
LADD     LA    7,ER12                  INVALID OUTPUT OPTION            10502258
         OI    SWIT,X'08'              SET INV ALID OUTPUT OPTION SWIT  10502259
         BALR  14,8                                                     10502260
         BC    15,RP                                                    10502261
A15      TM    DOPTN,X'0E'             VALID PUNCH OUTPUT OPTION        10502262
         BC    8,RP                                                     10502263
         BC    15,LADD                 NOT VALID                        10502264
ABC      TM    DOPTN,X'07'             OUTPUT OPTION BCD OR CHAR        10502265
         BC    8,RP                                                     10502266
         BC    15,LADD                                                  10502267
ERRTN    MVC   ER00(36),0(7)           MOVE MESSAGE TO PRINT AREA       10502268
         AH    11,ONE                   ADD 1 TO ERROR COUNTER          10502269
         BCTR  7,0                                                      10502270
         MVC   COM+7(1),0(7)           STORE LENGTH IN CCW              10502271
         SVC   0                                                        10502272
         DC    YL2(CCB)                                                 10502273
         TM    CCB+2,X'80'              WRITE FINISHED                  10502274
         BC    8,*-4                                                    10502275
         BCR   15,14                                                    10502276
COPFS    NI    DOPTN,X'F7'             REMOVE PRINT CHARACTER           10502277
         BC    15,ZZTT1                                                 10502278
*                                                                       10502279
***      MAIN LINE                                                      10502280
*                                                                       10502281
RP       LH    9,UCLIM                                                  10502282
         SR    1,1                                                      10502283
         SR    10,10                                                    10502284
         TM    TJOB,X'82'              BOTH  OR FIELD SELECT            10502285
         BC    4,*+12                                                   10502286
         TM    TJOB,X'FF'              LIST W/ FIELD SELECT             10502287
         BC    5,GEE2                                                   10502288
         LH    0,NOFS                                                   10502289
***  THIS REGISRER IS USED TO NUMBER THE FIELD SELECT ERROR MESSAGES    10502290
         LR    10,0                    GET CURRENT FS CARD ENTRY FROM   10502291
         LA    10,1(10)                ADD ONE TO REG 10                10502292
         LR    1,0                     GET THE NUMBER OF FS ENTRIES     10502293
         BCTR  1,0                                                      10502294
         MH    1,TWELVE                POINT TO THE LAST ONE            10502295
RP3      SH    0,ONE                   SUBT 1 FROM NOFS                 10502296
         BCTR  10,0                    POINT TO THE NEXT ENTRY          10502297
         LA    7,NOFS+2(1)                                              10502298
         TM    0(7),X'60'              TRANSLATE TO HEX                 10502299
         BC    1,TRANS1                                                 10502300
         BC    4,CC                                                     10502301
         MVC   ER16+32(4),ER43         MOVE FS TO ERROR MESSAGE         10502302
         MVC   ER31+4(4),ER43                                           10502303
         L     4,NOFS+10(1)                4          B                 10502304
         LR    6,4                                                      10502305
ZUTI     LH    2,NOFS+6(1)             REG 2 CONTAINS A                 10502306
         LH    3,NOFS+8(1)                 3          C                 10502307
         BCTR  2,0                                                      10502308
         BCTR  3,0                                                      10502309
         LTR   4,4                     N EQUAL ZERO TEST                10502310
         BC    8,UDOPE                                                  10502311
         TM    0(7),X'60'              TRANXLATE                        10502312
         BC    1,TRANS                                                  10502313
         LR    5,2                                                      10502314
         LR    7,3                                                      10502315
         AR    5,4                                                      10502316
         AR    7,6                                                      10502317
         CH    5,IRCLN                                                  10502318
         BC    2,ERRORA                                                 10502319
         CH    7,ORCLN                                                  10502320
         BC    2,ERRORA                                                 10502321
         LA    3,1(3)                                                   10502322
         LA    2,1(2)                                                   10502323
         LA    7,NOFS+2(1)                                              10502324
         TM    0(7),X'60'                                               10502325
         BC    4,BB                                                     10502326
         BAL   14,GG                                                    10502327
         BC    15,L                                                     10502328
TRANS1   MVC   ER16+32(4),ER42         MOVE HEX TO ERROR MESSAGE        10502329
         MVC   ER31+4(4),ER42                                           10502330
         BC    15,ZUTI-6                                                10502331
L        CH    0,ZERO                  ALL FS PARAMETERS PROCESSDD      10502332
         BC    2,ADER                                                   10502333
GEE2     STH   9,UCLIM                 STORE INST ADDRESS               10502334
         SH    9,LABRTN                SUBT LAST ADDRESS OF PHASE 4     10502335
MAXY     STH   9,MAXIO                 STORE AVAILABLE CORE FOR I/O     10502336
         TM    TJOB,X'61'              COPY BOTH OR LIST                10502337
         BC    4,ASSIGN                                                 10502338
         MVI   CHANGE+1,X'80'                                           10502339
         BC    15,ASSIGN                                                10502340
ADER     SH    1,TWELVE                                                 10502341
         BC    15,RP3                                                   10502342
CC       LH    4,NOFS+10(1)            REG 4 CONTAINS N                 10502343
         LH    6,NOFS+12(1)                6          M                 10502344
         TM    0(7),X'40'                                               10502345
         BC    1,UNPKR                                                  10502346
         MVC   ER16+32(4),ER45         MOVE PACK TO ERROR MESSAGE       10502347
         MVC   ER31+4(4),ER45                                           10502348
         BC    15,ZUTI                                                  10502349
UNPKR    MVC   ER16+32(4),ER44         MOVE UNPK TO ERROR MESSAGE       10502350
         MVC   ER31+4(4),ER44                                           10502351
         BC    15,ZUTI                                                  10502352
ERRORA   LA    7,ER16                  LOAD ERROR MESSAGE               10502353
         BAL   14,CVD                                                   10502354
         UNPK  ER16(3),OUTARA(8)                                        10502355
         BALR  14,8                                                     10502356
         BC    15,L                                                     10502357
UDOPE    LA    7,ER31                  N EQUALS ZERO                    10502358
         BAL   14,CVD                                                   10502359
         UNPK  ER31(3),OUTARA(8)                                        10502360
         BALR  14,8                                                     10502361
         BC    15,L                                                     10502362
*                                                                       10502363
***      UNPACK ROUTINE                                                 10502364
*                                                                       10502365
Z        LH    2,NOFS+6(1)              REG 2 CONTAINS A                10502366
         LH    3,NOFS+8(1)                  3          C                10502367
         LH    4,NOFS+10(1)                 4          N                10502368
         LH    5,NOFS+12(1)                 5          M                10502369
         AH    2,XSIX                       2          A AND REG 6      10502370
         AH    3,XTEN                       3          C AND REG 10     10502371
         BCTR  2,0                                                      10502372
         BCTR  3,0                                                      10502373
         STH   2,UNPK2+4                 STORE A,C IN UNPACK2           10502374
         STH   3,UNPK2+2                                                10502375
         STH   3,MVI+2                                                  10502376
         STH   3,MVC+4                                                  10502377
         AH    3,ONE                                                    10502378
         STH   3,MVC+2                                                  10502379
         BCTR  3,0                                                      10502380
         CH    4,EIGHT                  N LESS OR EQUAL TO 8            10502381
         BC    12,LES                                                   10502382
         AR    2,4                      A AND C NOW POINT TO THE LAST   10502383
         AR    3,5                      BYTE +1 OF THEIR AREAS          10502384
         BCTR  2,0                                                      10502385
         BCTR  3,0                                                      10502386
ALPHA    CH    4,EIGHT                  N LESS OR EQUAL TO 8            10502387
         BC    12,LES                                                   10502388
         SH    2,SEVEN                                                  10502389
         SH    3,FORTEN                  SUBT 7,14 FROM A,C , N,M       10502390
         SH    4,SEVEN                                                  10502391
         SH    5,FORTEN                                                 10502392
         STH   2,UNPK1+4                                                10502393
         STH   3,UNPK1+2                                                10502394
         SH    9,SIX                    MOVE TO                         10502395
         MVC   0(6,9),UNPK1             UPPER CORE                      10502396
         BC    15,ALPHA                                                 10502397
LES      CH    5,ONE                   M LESS THAN ONE                  10502398
         BC    4,ERRO                                                   10502399
         CH    5,SIXTEN                M GREATER THAN 16                10502400
         BC    12,GEBER1                                                10502401
         CH    5,TWO56                 M GREATER THAN 256               10502402
         BC    2,ERRO                                                   10502403
         BCTR  5,0                                                      10502404
         STC   5,MVC+1                   STORE LENGTH                   10502405
         SH    3,FORTEN                  SUBT 14 FROM C                 10502406
         STH   3,UNPK2+2               STORE C AND REGS IN INST         10502407
         BCTR  4,0                                                      10502408
         STC   4,UNPK2+1                 STORE N                        10502409
         MVZ   UNPK2+1(1),UNPK1+1      STORE M IN LENGTH                10502410
         SH    9,SIXTEN                  SUBT INST LENGTH               10502411
         MVC   0(16,9),MVI               MOVE TO UPPER CORE             10502412
         BC    15,L                                                     10502413
GEBER1   BCTR  4,0                                                      10502414
         BCTR  5,0                                                      10502415
ASTER    SLA   5,4                      GET ONE BYTE LENGTH MIN         10502416
         AR    5,4                                                      10502417
         STC   5,UNPK2+1                LENGTH IS STORED                10502418
         SH    9,SIX                                                    10502419
         MVC   0(6,9),UNPK2                                             10502420
         BC    15,L                                                     10502421
*                                                                       10502422
***    GENERATE ROUTINE FOR FIELD SELECT AND REBLOCKING                 10502423
*                                                                       10502424
GG       LH    5,TWO56                 REG 5 CONTAINS 256               10502425
         LR    7,5                          7          255              10502426
         BCTR  7,0                                                      10502427
         AH    2,XSIX                       2          A AND REG 6      10502428
         AH    3,XTEN                       3          C AND REG 10     10502429
         BCTR  2,0                                                      10502430
         BCTR  3,0                                                      10502431
BACK     CR    4,5                      B LESS OR EQUAL TO 256          10502432
         BC    12,LAST                                                  10502433
         STH   2,MOVE+4                 NO - STORE A AND C              10502434
         STH   3,MOVE+2                                                 10502435
         AR    2,5                      ADD 256 TO A AND C              10502436
         AR    3,5                                                      10502437
         STC   7,MOVE+1                 STORE 255 IN DUMMY INST         10502438
         SR    4,5                      SUBT  256 FROM B                10502439
         SH    9,SIX                   SUBT INST LENGTH                 10502440
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10502441
         BC    15,BACK                                                  10502442
LAST     STH   2,MOVE+4                GENERATE LAST MOVE               10502443
         STH   3,MOVE+2                                                 10502444
         BCTR  4,0                                                      10502445
         STC   4,MOVE+1                                                 10502446
         SH    9,SIX                   SUBT INST LENGTH                 10502447
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10502448
         BCR   15,14                    RETURN                          10502449
*                                                                       10502450
***      TRANSLATE ROUTINE                                              10502451
*                                                                       10502452
TRANS    LH    2,NOFS+6(1)             REG 2 CONTAINS A                 10502453
         LH    3,NOFS+8(1)                 3          C                 10502454
         BCTR  3,0                                                      10502455
         BCTR  2,0                                                      10502456
         L     4,NOFS+10(1)                4          B                 10502457
         LR    5,4                         5          B                 10502458
         AR    5,2                         5          B+A               10502459
         CH    5,IRCLN                                                  10502460
         BC    13,GO1ON                                                 10502461
         BC    15,ERRORA                                                10502462
GO1ON    AR    4,4                     DOUBLE B                         10502463
         LR    5,4                     REG 5 CONTAINS 2B                10502464
         AR    5,3                         5          2B+C              10502465
         CH    5,ORCLN                                                  10502466
         BC    13,GO2ON                                                 10502467
         BC    15,ERRORA                                                10502468
GO2ON    AH    3,XTEN                  PUT REG IN  ADDRESS              10502469
         LA    2,1(2)                                                   10502470
         LA    3,1(3)                                                   10502471
         BCTR  3,0                                                      10502472
ZEROX    CH    4,TWO56                 B GREATER THAN 256               10502473
         BC    13,ENDFIN                                                10502474
         STH   3,TR1+2                 STORE ADDRESS IN INST            10502475
         SH    9,SIX                                                    10502476
         MVC   0(6,9),TR1              MOVE TO UPPER CORE               10502477
         SH    4,TWO56                 SUBT 256 DROM B                  10502478
         AH    3,TWO56                 ADD 256 TO C                     10502479
         BC    15,ZEROX                                                 10502480
ENDFIN   BCTR  4,0                                                      10502481
         STC   4,TR+1                  STORE PARAMETERS                 10502482
         STH   3,TR+2                                                   10502483
         SH    9,SIX                   SUBT INST LENGHT                 10502484
         MVC   0(6,9),TR               MOVE TO UPPER CORE               10502485
         LH    2,NOFS+6(1)             SET REGS FOR                     10502486
         LH    3,NOFS+8(1)             UNPACK                           10502487
         L     4,NOFS+10(1)                                             10502488
         LR    5,4                     REG 4 CONTAINS N                 10502489
         AR    5,5                         5          M WHICH EQUALS 2N 10502490
         BCTR  5,0                                                      10502491
         LR    7,5                     REG 7 CONTAINS 2B                10502492
         AR    7,3                         7          2B+C              10502493
         BCTR  7,0                                                      10502494
         AH    7,XTEN                      7          2B+(C-1)+REG 13   10502495
         STH   7,PACK3+2               STORE ADDRESS                    10502496
         STH   7,ORI1+2                                                 10502497
         BCTR  7,0                                                      10502498
         STH   7,PACK3+4                                                10502499
         STH   7,ORI+2                                                  10502500
         SH    9,FORTEN                                                 10502501
         MVC   0(14,9),PACK3           MOVE INSTRUCTIONS TO UPPER CORE  10502502
         BC    15,Z+16                 GO TO UNPACK ROUTINE             10502503
*                                                                       10502504
***      PACK ROUTINE                                                   10502505
*                                                                       10502506
BB       LA    7,NOFS+2(1)             MOVE ADDRESS OF TYPE INTO REG 7  10502507
         TM    0(7),X'20'              IS IT PACK                       10502508
         BC    8,Z                                                      10502509
         LH    2,NOFS+6(1)              REG 2 CONTAINS A                10502510
         LH    3,NOFS+8(1)                  3          C                10502511
         LH    4,NOFS+10(1)                 4          N                10502512
         LH    5,NOFS+12(1)                 5          M                10502513
         AH    2,XSIX                       2          A AND REG 6      10502514
         AH    3,XTEN                       3          C         10     10502515
         BCTR  2,0                                                      10502516
         BCTR  3,0                                                      10502517
         STH   2,PACK2+4               STORE A AND REGS IN PACK         10502518
         STH   3,PACK2+2                                                10502519
         STH   3,XCL+2                 STORE C AND REGS IN PACK AND XC  10502520
         STH   3,XCL+4                                                  10502521
         CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10502522
         BC    12,LES2                                                  10502523
         AR    2,4                     ADD N-1,M-1 TO A,C               10502524
         AR    3,5                                                      10502525
         BCTR  2,0                                                      10502526
         BCTR  3,0                                                      10502527
BETA     CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10502528
         BC    12,LES2                                                  10502529
         SH    2,FORTEN                SUBT 14,7 FROM A,C               10502530
         SH    3,SEVEN                                                  10502531
         STH   2,PACK1+4               A AND C IN INSTRUCTION           10502532
         STH   3,PACK1+2                                                10502533
         SH    4,FORTEN                 SUBT(14,7) FROM (A,C)AND (N,M)  10502534
         SH    5,SEVEN                                                  10502535
         SH    9,SIX                    SUBT INST LENGTH                10502536
         MVC   0(6,9),PACK1            MOVE TO UPPER CORE               10502537
         BC    15,BETA                                                  10502538
LES2     CH    5,ONE                   M LESS THAN 2                    10502539
         BC    4,ERRO1                                                  10502540
         CH    5,SIXTEN                M GREZTER THAN 16                10502541
         BC    12,GEBER                                                 10502542
         CH    5,TWO56                 M GREATER THAN 256               10502543
         BC    2,ERRO1                                                  10502544
         BCTR  5,0                                                      10502545
         STC   5,XCL+1                 STORE LENGTH IN EXCLUSIVE OR     10502546
         SH    3,FORTEN                SUBT 14 FROM C AND REGS          10502547
         STH   3,PACK2+2                                                10502548
         BCTR  4,0                                                      10502549
         STC   4,PACK2+1               STORE N-1                        10502550
         MVZ   PACK2+1(1),KONST        PUT 15 UN INST LENGTH            10502551
         SH    9,TWELVE                SUBT INST LENGTH                 10502552
         MVC   0(12,9),XCL             MOVE INSTRUCTIONS TO UPPER CORE  10502553
         BC    15,L                                                     10502554
GEBER    BCTR  4,0                                                      10502555
         BCTR  5,0                                                      10502556
         SLA   5,4                      AND                             10502557
         AR    5,4                      STORE                           10502558
         STC   5,PACK2+1                                                10502559
         SH    9,SIX                   SUBT INST LENGTH                 10502560
         MVC   0(6,9),PACK2            MOVE TO UPPER COE                10502561
         BC    15,L                                                     10502562
*                                                                       10502563
***     ASSIGN  IO  AREAS                                               10502564
*                                                                       10502565
ASSIGN   OI    SWIT,X'01'                                               10502566
         LH    2,TWO                                                    10502567
         LH    1,MAXIO                 A EQUALS 2,IO LIMIT IS IN REG 1  10502568
         N     1,ANDOP                                                  10502569
         LH    10,OBKSZ                                                 10502570
         LH    9,IBKSZ                 GET INKSZ IN REG 9               10502571
         N     10,ANDOP                                                 10502572
         N     9,ANDOP                 GET RID OF MINUS                 10502573
         LR    3,2                          B=2                         10502574
RETURN   LR    7,3                                                      10502575
         LR    5,2                                                      10502576
         MR    6,10                                                     10502577
         MR    4,9                                                      10502578
         AR    5,7                                                      10502579
         CR    5,1                                                      10502580
         BC    12,ASGN                 ASSIGN AREAS IF POSSIBLE         10502581
TEST     TM    SWIT,X'01'                   SWITCH ON TEST              10502582
         BC    1,ON                                                     10502583
         OI    SWIT,X'01'                   TURN SWITCH ON              10502584
         BCTR  3,0                                                      10502585
         AH    2,ONE                   ADD ONE TO A                     10502586
         LTR   3,3                     B LESS THAN ZERO TEST            10502587
         BC    4,ERROR                      YES                         10502588
         BC    15,RETURN                    NO                          10502589
ON       NI    SWIT,X'FE'                   TURN SWITCH OFF             10502590
         BCTR  2,0                                                      10502591
         BC    15,RETURN                                                10502592
ERROR    LA    8,ERRTN                                                  10502593
         LA    7,ER14                   LOAD  ADDRESS                   10502594
         OI    SWIT,X'04'              SET SUPRESS I/O PRINT SWITCH     10502595
         BALR  14,8                    GO TO ERROR ROUTINE              10502596
GOERT    STH   11,FOR096               STORE NUMBER OF ERRORS           10502597
         BC    15,ENDLOG                                                10502598
*                                                                       10502599
***   ACTUAL ASSIGNING OF INPUT OUTPUT AREAS                            10502600
*                                                                       10502601
ASGN     LTR   3,3                                                      10502602
CHANGE   BC    6,TEST                  IF TYPE COPY, BC6, IF NOT BC8    10502603
         LH    6,LABRTN                                                 10502604
         BC    8,STOR3                 IF ZERO, A = 0                   10502605
         STH   6,INA                   STORE ASDRESS IN INA             10502606
         BCTR  2,0                                                      10502607
         LTR   2,2                     TEST FOR A ' ZERO                10502608
         BC    8,STOR                                                   10502609
         AR    6,9                                                      10502610
STOR     STH   6,INB                   STOR ADDRESS IN INB              10502611
         LTR   3,3                     B = 0 TEST                       10502612
         BC    8,STOR2                                                  10502613
         AR    6,9                                                      10502614
         STH   6,OUTA                                                   10502615
         BCTR  3,0                                                      10502616
         LTR   3,3                     B = 0 TEST                       10502617
         BC    8,STOR1                                                  10502618
         AR    6,10                                                     10502619
STOR1    STH   6,OUTB                  STORE ADDRESS IN OUT B           10502620
         BC    15,LOG                                                   10502621
STOR2    MVC   INA(2),OUTA             COMBINED I/O AREAS               10502622
         MVC   INB(2),OUTB             MAKE IN AND OUT CORRESPOND       10502623
         BC    15,LOG                                                   10502624
STOR3    STH   6,INA                   STORE ADDRESS IN                 10502625
         STH   6,OUTA                  INA AND POUT A                   10502626
         BCTR  2,0                                                      10502627
         LTR   2,2                                                      10502628
         BC    8,STOR4                 B = 0 TEST                       10502629
         AR    6,10                                                     10502630
STOR4    STH   6,INB                                                    10502631
         STH   6,OUTB                                                   10502632
LOG      SR    7,7                     CLEAR REG 7 TO ZERO              10502633
         CLC   INA(2),INB                                               10502634
         BC     8,*+8                  /NA EQUAL INB  ADD ONLY 16       10502635
         AH    7,SIXTEN                                                 10502636
         AH    7,SIXTEN                                                 10502637
         CLC    OUTA(2),OUTB                                            10502638
         BC    8,*+8                   OUTA EQUAL OUTB  ADD ONLY 1      10502639
         AH     7,ONE                                                   10502640
         AH     7,ONE                                                   10502641
         STC    7,NOIO                                                  10502642
         BC    15,GOERT                                                 10502643
*                                                                       10502644
***      LOG JOB ROUTINE                                                10502645
*                                                                       10502646
ENDLOG   LH    6,IRCLN                                                  10502647
         MVI   CVD+1,X'60'             CHANGE THE REGISTER IN THE CVD   10502648
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10502649
         BC    4,*+20                  BYPASS RECORD FORMAT PRINT       10502650
         BAL   14,CVD                                                   10502651
         UNPK  ER18+20(4),OUTARA(8)                                     10502652
         LA    7,ER18                                                   10502653
         BALR  14,8                    GO TO ERROR ROUTINE              10502654
         LH    6,IBKSZ                                                  10502655
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10502656
         BAL   14,CVD                                                   10502657
         UNPK  ER19+17(5),OUTARA(8)          IBKSZ                      10502658
         LA    7,ER19                                                   10502659
         BALR  14,8                    GO TO ERROR ROUTINE              10502660
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10502661
         BC    4,*+24                  BYPASS RECORD FORMAT PRINT       10502662
         LH    6,ORCLN                                                  10502663
         BAL   14,CVD                                                   10502664
         UNPK  ER20+22(4),OUTARA(8)                                     10502665
         LA    7,ER20                                                   10502666
         BALR  14,8                    GO TO ERROR ROUTINE              10502667
         LH    6,OBKSZ                                                  10502668
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10502669
         BAL   14,CVD                                                   10502670
         UNPK  ER21+18(5),OUTARA(8)      OBKSZ                          10502671
         LA    7,ER21                                                   10502672
         BALR  14,8                    GO TO ERROR ROUTINE              10502673
         TM    SWIT,X'02'              TEST FOR INVALID INPUT OPTION    10502674
         BC    1,TM                                                     10502675
         TM    DOPTN,X'10'             CA*D BINARY                      10502676
         BC    8,B1                                                     10502677
         MVC   ER22+13(11),ER48A       CARD BINARY                      10502678
         BC    15,PRINTZ                                                10502679
B1       MVC   ER22+13(8),ER47A        CARD BCD                         10502680
PRINTZ   LA    7,ER22                                                   10502681
         BALR  14,8                                                     10502682
TM       TM    SWIT,X'08'              TEST FOR INVALID OUTPUT OPTION   10502683
         BC    1,RETUNR+6                                               10502684
         TM    TJOB,X'C0'              B OR BF                          10502685
         BC    8,TM1                                                    10502686
         MVC   ER23+14(13),ER47B                                        10502687
         BC    15,RETUNR                                                10502688
TM1      TM    DOPTN,X'04'             PRINT HEX                        10502689
         BC    8,B2                                                     10502690
         MVC   ER23+14(9),ER48         POVE MESSAGE TO MASTER           10502691
         BC    15,RETUNR                                                10502692
B2       TM    DOPTN,X'08'             PRINT HEX                        10502693
         BC    8,B3                                                     10502694
         MVC   ER23+14(15),ER47        PRINT CHARACTER                  10502695
         BC    15,RETUNR                                                10502696
B3       TM    DOPTN,X'01'             CARD BINARY                      10502697
         BC    8,B4                                                     10502698
         MVC   ER23+14(11),ER48A       CARD BINARY                      10502699
         BC    15,RETUNR                                                10502700
B4       MVC   ER23+14(8),ER47A        CARD BCD                         10502701
RETUNR   LA    7,ER23                                                   10502702
         BALR  14,8                    GO TO ERROR ROUTINE              10502703
         TM    SWIT,X'04'              TEST SUPRESS I/O PRINT SWITCH    10502704
         BC    1,LOADZ+6                                                10502705
         TM    TJOB,X'21'              COPY OR LIST                     10502706
         BC    4,MUV                                                    10502707
         TM    NOIO,X'02'               2 OUTPUT                        10502708
         BC    1,STORTO                                                 10502709
         MVI   ER24+8,X'F1'            PUT 1 IN OUTPUT                  10502710
ZERT     TM    NOIO,X'20'               2 INPUT                         10502711
         BC    1,STORTT                                                 10502712
         MVI   ER24,X'F1'              PUT 1 IN INPUT                   10502713
LOADZ    LA    7,ER24                                                   10502714
         BALR  14,8                    GO TO ERROR ROUTINE              10502715
         TM    FRCD,X'01'              FIXED INPUT                      10502716
         BC    1,FIXED                                                  10502717
         TM    FRCD,X'02'              VARIABLE INPUT                   10502718
         BC    1,VAR                                                    10502719
         MVC   ER32+14(9),ER40         MOVE UNDEFINED TO MESSAGE        10502720
LO       LA    7,ER32                                                   10502721
         BALR  14,8                                                     10502722
         TM    SWIT,X'20'              INVALID PROGRAM TYPE             10502723
         BC    1,WRITE+6                                                10502724
         TM    TJOB,X'10'              DATA DISPLAY                     10502725
         BC    8,*+14                                                   10502726
         MVC   ER33+5(12),ER39G                                         10502727
         BC    15,WRITE                                                 10502728
         TM    TJOB,X'20'              LIST                             10502729
         BC    8,*+14                                                   10502730
         MVC   ER33+5(4),ER39E                                          10502731
         BC    15,WRITE                                                 10502732
         TM    TJOB,X'40'              BOTH                             10502733
         BC    8,*+14                                                   10502734
         MVC   ER33+5(15),ER39H                                         10502735
         BC    15,WRITE                                                 10502736
         TM    TJOB,X'80'              BOTH ND FIELD SELECT             10502737
         BC    8,*+14                                                   10502738
         MVC   ER33+5(24),ER39I                                         10502739
         BC    15,WRITE                                                 10502740
         TM    TJOB,X'01'              COPY                             10502741
         BC    8,*+14                                                   10502742
         MVC   ER33+5(4),ER39J                                          10502743
         BC    15,WRITE                                                 10502744
         TM    TJOB,X'02'              FIELD SELECT                     10502745
         BC    8,*+14                                                   10502746
         MVC   ER33+5(12),ER26                                          10502747
         BC    15,WRITE                                                 10502748
         MVC   ER33+5(17),ER39F        LIST AND FIELD DELECT            10502749
WRITE    LA    7,ER33                                                   10502750
         BALR  14,8                                                     10502751
         LH    6,QORS                  PUT COLUMN IN REG (SEQ)          10502752
         BAL   14,CVD                                                   10502753
         UNPK  ER35+26(2),OUTARA(8)                                     10502754
         LA    7,ER35                                                   10502755
         BALR  14,8                                                     10502756
         LH    6,QORS+2                PUT SEQ LENGTH IN REG            10502757
         BAL   14,CVD                                                   10502758
         UNPK  ER36+16(2),OUTARA(8)                                     10502759
         LA    7,ER36                                                   10502760
         BALR  14,8                                                     10502761
         LH    11,FOR096                                                10502762
         CH    11,ZERO                                                  10502763
         BC    8,SVC                                                    10502764
         SVC   1                                                        10502765
         DC    C'SYSEOJ'                                                10502766
SVC      SVC   1                                                        10502767
         DC    C'SYSLOD'                                                10502768
MUV      TM    NOIO,X'02'                                               10502769
         BC    1,STTT                                                   10502770
         MVI   ER25,X'F1'              PUT 1 IN I/O                     10502771
ZIPPY    LA    7,ER25                                                   10502772
         BALR  14,8                    GO TO ERROR ROUTINE              10502773
         BC    15,LOADZ+6                                               10502774
STTT     MVI   ER25,X'F2'              PUT 2 IN I/O                     10502775
         BC    15,ZIPPY                                                 10502776
STORTO   MVI   ER24+8,X'F2'            PUT 2 IN OUTPUT                  10502777
         BC    15,ZERT                                                  10502778
STORTT   MVI   ER24,X'F2'              PUT 2 IN INPUT                   10502779
         BC    15,LOADZ                                                 10502780
CVD      CVD   10,OUTARA               CONVERT TO DECIMAL               10502781
         OI    OUTARA+7,X'0F'          PUT SIGN INTO CONVERTED NUMBER   10502782
         BCR   15,14                                                    10502783
FIXED    MVC   ER32+14(9),ER42A                                         10502784
         BC    15,LO                                                    10502785
VAR      MVC   ER32+14(9),ER41         MOVE VARIABLE TO MESAGE          10502786
         BC    15,LO                                                    10502787
*                                                                       10502788
***      CONSTANTS                                                      10502789
*                                                                       10502790
         CNOP  0,8                                                      10502791
OUTARA   DC    D'0'                                                     10502792
CCB      DC    F'0'                                                     10502793
         DC    X'0014'                                                  10502794
         DC    YL2(COM)                                                 10502795
COM      DC    X'09'                                                    10502796
         DC    AL3(ER00)                                                10502797
         DC    X'20000032'                                              10502798
ANDOP    DC    X'0000FFFF'                                              10502799
PACK1    PACK  0(8,0),0(15,0)                                           10502800
XCL      XC    0(0,0),0(0)                                              10502801
PACK2    PACK  0(8,0),0(15,0)                                           10502802
MOVE     MVC   0(0,0),0(0)              DUMMY INST                      10502803
BRANCH   BCR   15,7                                                     10502804
UNPK1    UNPK  0(15,0),0(8,0)                                           10502805
MVI      MVI   0(0),X'F0'                                               10502806
MVC      MVC   0(0,0),0(0)                                              10502807
UNPK2    UNPK  0(0,0),0(0,0)                                            10502808
TR1      TR    0(256),DSTBL-240                                         10502809
TR       TR    0(256),DSTBL-240                                         10502810
PACK3    PACK  0(1,0),0(1,0)                                            10502811
ORI      OI    0(0),X'F0'                                               10502812
ORI1     OI    0(0),X'F0'                                               10502813
ERRO1    LA    7,ER17                                                   10502814
         BAL   14,CVD                                                   10502815
         UNPK  ER17(3),OUTARA(8)                                        10502816
         BALR  14,8                                                     10502817
         BC    15,L                                                     10502818
ERRO     LA    7,ER15                                                   10502819
         BAL   14,CVD                                                   10502820
         UNPK  ER15(3),OUTARA(8)                                        10502821
         BALR  14,8                                                     10502822
         BC    15,L                                                     10502823
XTEN     DC    X'A000'                                                  10502824
XSIX     DC    X'6000'                                                  10502825
ZERO     DC    H'0'                                                     10502826
ONE      DC    X'0001'                                                  10502827
TWO      DC    H'2'                                                     10502828
SIX      DC    H'6'                                                     10502829
SEVEN    DC    H'7'                                                     10502830
EIGHT    DC    H'8'                                                     10502831
TEN      DC    H'10'                                                    10502832
TWELVE   DC    H'12'                                                    10502833
FORTEN   DC    H'14'                                                    10502834
SIXTEN   DC    H'16'                                                    10502835
EIGHTY   DC    H'80'                                                    10502836
ONE44    DC    H'144'                                                   10502837
ONE60    DC    H'160'                                                   10502838
TWO56    DC    H'256'                                                   10502839
FOR096   DC    H'4096'                                                  10502840
ATEK     DC    H'8192'                                                  10502841
SWIT     DC    X'0000'                                                  10502842
KONST    DC    X'EF00'                                                  10502843
MAXIO    DC    H'0'                                                     10502844
DISP     DC    X'00780078'                                              10502845
         DC    X'20'                                                    10502846
ER00     DC    C'CARD TO PRINTER '                                      10502847
         DC    C'/ PUNCH UTILITY '                                      10502848
         DC    F'0'                                                     10502849
         DC    X'11'                                                    10502850
ER0      DC    C'INCORRECT PROGRA'                                      10502851
         DC    C'M'                                                     10502852
         DC    X'16'                                                    10502853
ER1      DC    C'INCORRECT INPUT '                                      10502854
         DC    C'DEVICE'                                                10502855
         DC    X'17'                                                    10502856
ER2      DC    C'INCORRECT OUTPUT'                                      10502857
         DC    C' DEVICE'                                               10502858
         DC    X'1E'                                                    10502859
ER3      DC    C'B ILLEGAL FORMAT'                                      10502860
         DC    C' UTIL MOD CARD'                                        10502861
         DC    X'23'                                                    10502862
ER5      DC    C'FIXED LENGTH REC'                                      10502863
         DC    C'ORD FORMAT REQUI'                                      10502864
         DC    C'RED'                                                   10502865
         DC    X'1C'                                                    10502866
ER6      DC    C'INVALID JOB FOR '                                      10502867
         DC    C'THIS PROGRAM'                                          10502868
         DC    X'1B'                                                    10502869
ER7      DC    C'INVALID INPUT RE'                                      10502870
         DC    C'CORD LENGTH'                                           10502871
         DC    X'1A'                                                    10502872
ER8      DC    C'INVALID INPUT BL'                                      10502873
         DC    C'OCK LENGTH'                                            10502874
         DC    X'1C'                                                    10502875
ER9      DC    C'INVALID OUTPUT R'                                      10502876
         DC    C'ECORD LENGTH'                                          10502877
         DC    X'1B'                                                    10502878
ER10     DC    C'INVALID OUTPUT B'                                      10502879
         DC    C'LOCK LENGTH'                                           10502880
         DC    X'14'                                                    10502881
ER11     DC    C'INVALID INPUT OP'                                      10502882
         DC    C'TION'                                                  10502883
         DC    X'15'                                                    10502884
ER12     DC    C'INVALID OUTPUT O'                                      10502885
         DC    C'PTION'                                                 10502886
         DC    X'15'                                                    10502887
ER13     DC    C'INVALID CARD SEQ'                                      10502888
         DC    C'UENCE'                                                 10502889
         DC    X'1B'                                                    10502890
ER14     DC    C'I/O AREA CANNOT '                                      10502891
         DC    C'BE ASSIGNED'                                           10502892
         DC    X'20'                                                    10502893
ER15     DC    C'    INVALID UNPA'                                      10502894
         DC    C'CK OUTPUT LENGTH'                                      10502895
         DC    X'24'                                                    10502896
ER16     DC    C'    RECORD CAPAC'                                      10502897
         DC    C'ITY EXCEEDED BY '                                      10502898
         DC    C'    '                                                  10502899
         DC    X'1E'                                                    10502900
ER17     DC    C'    INVALID PACK'                                      10502901
         DC    C' OUTPUT LENGTH'                                        10502902
         DC    X'18'                                                    10502903
ER18     DC    C'INPUT RECORD LEN'                                      10502904
         DC    C'GTH     '                                              10502905
         DC    X'16'                                                    10502906
ER19     DC    C'INPUT BLOCK SIZE'                                      10502907
         DC    C'      '                                                10502908
         DC    X'1A'                                                    10502909
ER20     DC    C'OUTPUT RECORD LE'                                      10502910
         DC    C'NGTH      '                                            10502911
         DC    X'17'                                                    10502912
ER21     DC    C'OUTPUT BLOCK SIZ'                                      10502913
         DC    C'E      '                                               10502914
         DC    X'20'                                                    10502915
ER22     DC    C'INPUT OPTION    '                                      10502916
         DC    C'                '                                      10502917
         DC    X'20'                                                    10502918
ER23     DC    C'OUTPUT OPTION   '                                      10502919
         DC    C'                '                                      10502920
         DC    X'1F'                                                    10502921
ER24     DC    C'  INPUT,  OUTPUT'                                      10502922
         DC    C' AREAS ASSIGNED'                                       10502923
         DC    X'20'                                                    10502924
ER25     DC    C'   INPUT / OUTPU'                                      10502925
         DC    C'T AREAS ASSIGNED'                                      10502926
         DC    X'1E'                                                    10502927
ER26     DC    C'FIELD SELECT MUS'                                      10502928
         DC    C'T BE SPECIFIED'                                        10502929
         DC    X'21'                                                    10502930
ER31     DC    C'         INPUT L'                                      10502931
         DC    C'ENGTH EQUALS ZER'                                      10502932
         DC    C'O'                                                     10502933
         DC    X'17'                                                    10502934
ER32     DC    C'RECORD FORMAT   '                                      10502935
         DC    C'       '                                               10502936
         DC    X'1D'                                                    10502937
ER33     DC    C'TYPE            '                                      10502938
         DC    C'             '                                         10502939
         DC    X'1C'                                                    10502940
ER35     DC    C'STARTING SEQUENC'                                      10502941
         DC    C'E COLUMN    '                                          10502942
         DC    X'12'                                                    10502943
ER36     DC    C'SEQUENCE LENGTH '                                      10502944
         DC    C'  '                                                    10502945
ER39E    DC    C'LIST'                                                  10502946
ER39F    DC    C'LIST,FIELD SELEC'                                      10502947
         DC    C'T'                                                     10502948
ER39G    DC    C'DATA DISPLAY'                                          10502949
ER39H    DC    C'PRINT AND PUNCH'                                       10502950
ER39I    DC    C'PRINT,PUNCH,FIEL'                                      10502951
         DC    C'D SELECT'                                              10502952
ER39J    DC    C'COPY'                                                  10502953
ER40     DC    C'UNDEFINED'                                             10502954
ER41     DC    C'VARIABLE '                                             10502955
ER42A    DC    C'FIXED    '                                             10502956
ER42     DC    C'HEX '                                                  10502957
ER43     DC    C'FS  '                                                  10502958
ER44     DC    C'UNPK'                                                  10502959
ER45     DC    C'PACK'                                                  10502960
ER47     DC    C'PRINT CHARACTER '                                      10502961
ER47A    DC    C'CARD BCD'                                              10502962
ER47B    DC    C'BCD,CHARACTER'                                         10502963
ER48     DC    C'PRINT HEX'                                             10502964
ER48A    DC    C'CARD BINARY'                                           10502965
         ORG   STAR+3826                                                10502966
NOFS     DS    H                                                        10502967
         END   START                                                    10502968
         TITLE 'PHASE 4   CARD TO PRINTER/PUNCH'                        10502969
         START 2752                                                     10502970
STRT     BALR  15,0                                                     10502971
         USING *,15                                                     10502972
         BC    15,STAT                                                  10502973
*                                                                       10502974
****  ** PHASE IV,  CARD TO PRINT AND PUNCH PROGRAM **                  10502975
*                                                                       10502976
***   INPUT OPERATION                                                   10502977
*                                                                       10502978
AAA      LH    11,OUTA        CLEAR OUTPUT AREA                         10502979
         LH    7,OBKSZ                                                  10502980
         BCTR  7,0                                                      10502981
         BCTR  7,0                                                      10502982
         MVI   0(11),X'40'                                              10502983
         STC   7,*+5                                                    10502984
         MVC   1(0,11),0(11)                                            10502985
         LH    11,OUTB                                                  10502986
         MVI   0(11),X'40'                                              10502987
         STC   7,*+5                                                    10502988
         MVC   1(0,11),0(11)                                            10502989
ISVC     DC    X'4700'                                                  10502990
         DC    YL2(CCBIA)                                               10502991
AA3      BC    0,AG3          IS INPUT AREA EXHAUSTED                   10502992
AB3      BC    0,AB2          IS 1-INPUT AREA                           10502993
         TM    2(1),X'80'     WAIT INPUT                                10502994
         BC    8,*-4                                                    10502995
         TM    3(1),X'04'     IS INPUT END OF FILE                      10502996
         BC    7,IEOV                                                   10502997
         TM    3(1),X'40'     IS INCORRECT LENGTH                       10502998
         BC    8,AD4-4                                                  10502999
         OI    SWDP,X'04'     SET INCORRECT LENGTH                      10503000
         MVC   RSCNT(2),0(1)  SUPPLY RESIDUAL COUNT                     10503001
         OI    SWDP,X'01'     SET NEW BLOCK                             10503002
AD4      BC    15,CHGIM       CHANG INPUT LIST                          10503003
         MVC   ITAREA(2),INB                                            10503004
         LA    1,CCBIA                                                  10503005
         STH   1,CHGI1                                                  10503006
         LH    6,INB                                                    10503007
         STH   6,INFD         SET INFD                                  10503008
         LR    5,6                                                      10503009
         AH    5,IBKSZ                                                  10503010
         BCTR  5,0                                                      10503011
         BC    15,CHGIX                                                 10503012
CHGIM    MVC   ITAREA(2),INA                                            10503013
         LA    1,CCBIB                                                  10503014
         STH   1,CHGI1                                                  10503015
         LH    6,INA                                                    10503016
         STH   6,INFD         SET INFD                                  10503017
         LR    5,6                                                      10503018
         AH    5,IBKSZ                                                  10503019
         BCTR  5,0                                                      10503020
CHGIX    XI    AD4+1,X'F0'                                              10503021
         SVC   0              EXECUTE INPUT                             10503022
CHGI1    DC    YL2(CCBIB)                                               10503023
         BC    15,AG3                                                   10503024
AC2      NI    AB2+1,X'0F'                                              10503025
         BC    15,AD1                                                   10503026
AB2      BC    0,AC2                                                    10503027
         STH   1,*+6                                                    10503028
         SVC   0              EXECUTE INPUT                             10503029
         DC    YL2(CCBIA)                                               10503030
AD1      TM    2(1),X'80'     WAIT INPUT                                10503031
         BC    8,*-4                                                    10503032
         TM    3(1),X'04'     IS INPUT END OF FILE                      10503033
         BC    7,IEOV                                                   10503034
         TM    3(1),X'40'     IS INCORRECT LENGTH                       10503035
         BC    8,AF1-4                                                  10503036
         OI    SWDP,X'04'     SET INCORRECT LENGTH                      10503037
         MVC   RSCNT(2),0(1)  SUPPLY RESIDUAL COUNT                     10503038
         OI    SWDP,X'01'     SET NEW BLOCK                             10503039
AF1      BC    15,CHGM        CHANGE INPUT LIST                         10503040
         MVC   ITAREA(2),INB                                            10503041
         LA    1,CCBIA                                                  10503042
         STH   1,CHGI2                                                  10503043
         BC    15,CHGX                                                  10503044
CHGM     MVC   ITAREA(2),INA                                            10503045
         LA    1,CCBIB                                                  10503046
         STH   1,CHGI2                                                  10503047
CHGX     LH    6,INA                                                    10503048
         STH   6,INFD         SET INFD                                  10503049
         XI    AF1+1,X'F0'                                              10503050
*                                                                       10503051
***   MAIN LINE                                                         10503052
*                                                                       10503053
**    CARD SEQUENCE CHECK                                               10503054
*                                                                       10503055
AG3      BC    15,DDPLY       IS SEQUENCE CHECK SPECIFIED               10503056
         LH    7,ITAREA                                                 10503057
         BCTR  7,0                                                      10503058
SQMVC    MVC   SQCURR(1),0(7) SET CURRENT SEQUENCE                      10503059
         BC    15,SQOFF       IS FIRST TIME                             10503060
         CLC   SQCURR(10),SQLAST   COMPARE CURRENT SEQ WITH LAST SEQ    10503061
         BC    4,SQERR        ILLEGAL SEQUENCE                          10503062
SQCHG    MVC   SQLAST(10),SQCURR   MOVE CURRENT SEQ TO LAST SEQ         10503063
*                                                                       10503064
**    DATA DISPLAY                                                      10503065
*                                                                       10503066
DDPLY    TM    TJOB,X'10'     IS DATA DISPLAY                           10503067
         BC    8,SHR          NO, BRANCH TO SHR                         10503068
DPLY     BC    15,NWPG        PRINT 1ST PRINTING LINE                   10503069
         LH    11,OTAREA      SET REG11 WITH OTAREA                     10503070
         LH    7,OBKSZ                                                  10503071
         BCTR  7,0                                                      10503072
         STC   7,*+5                                                    10503073
         XC    0(0,11),0(11)                                            10503074
         NI    BA3+1,X'0F'    SET OUTPUT AREA EXHAUSTED                 10503075
         TM    SWDP,X'01'     IS NEW BLOCK                              10503076
         BC    8,DSRCK        NO, BRANCH TO DSRCK                       10503077
         NI    SWDP,X'FC'     SET SWDP OFF                              10503078
         LH    7,BKNO         PROVIDE BLOCK NO                          10503079
         LA    7,1(7)                                                   10503080
         STH   7,BKNO                                                   10503081
         CVD   7,DRCNO                                                  10503082
         OI    DRCNO+7,X'0F'                                            10503083
         UNPK  8(6,11),DRCNO(8)                                         10503084
         CLI   8(11),X'F0'                                              10503085
         BC    7,*+16                                                   10503086
         MVI   8(11),X'40'                                              10503087
         LA    11,1(11)                                                 10503088
         BC    15,*-16                                                  10503089
         LH    11,OTAREA                                                10503090
         TM    SWDP,X'04'     IS WRONG LENGTH                           10503091
         BC    8,PRRCD        NO, BRANCH TO PRRCD                       10503092
         NI    SWDP,X'FB'     SET SWDP OFF                              10503093
         LH    7,IBKSZ        PROVIDE BLOCK SIZE                        10503094
         SH    7,RSCNT                                                  10503095
         CVD   7,DRCNO                                                  10503096
         OI    DRCNO+7,X'0F'                                            10503097
         UNPK  0(8,11),DRCNO(8)                                         10503098
         CLI   0(11),X'F0'                                              10503099
         BC    7,*+16                                                   10503100
         MVI   0(11),X'40'                                              10503101
         LA    11,1(11)                                                 10503102
         BC    15,*-16                                                  10503103
         LH    11,OTAREA                                                10503104
PRRCD    LH    7,RCNO         PROVIDE RECORD NO                         10503105
         LA    7,1(7)                                                   10503106
         STH   7,RCNO                                                   10503107
         CVD   7,DRCNO                                                  10503108
         OI    DRCNO+7,X'0F'                                            10503109
         UNPK  14(5,11),DRCNO(8)                                        10503110
         CLI   14(11),X'F0'                                             10503111
         BC    7,*+16                                                   10503112
         MVI   14(11),X'40'                                             10503113
         LA    11,1(11)                                                 10503114
         BC    15,*-16                                                  10503115
         LH    11,OTAREA                                                10503116
DSST     LR    7,6            IS INFD+HNDRD SMALLER THAN INLRA+IRCLN    10503117
         AR    7,4                                                      10503118
         SH    7,HNDRD                                                  10503119
         CH    7,INFD                                                   10503120
         BC    2,DSWM         YES, BRANCH TO DSWM                       10503121
         NI    DSBC+1,X'0F'                                             10503122
         AH    7,HNDRD                                                  10503123
         SH    7,INFD                                                   10503124
HEXBC    BC    15,HEX         IS HEXADECIMAL                            10503125
         BCTR  7,0                                                      10503126
         STC   7,DSMVC+1                                                10503127
         LH    7,INFD                                                   10503128
DSMVC    MVC   20(0,11),0(7)                                            10503129
DSBC     BC    0,SOS                                                    10503130
         OI    SWDP,X'02'     SET NEW RECORD                            10503131
         BXLE  6,4,DSCHK      MODIFY RECORD ADDRESS                     10503132
         NI    AA3+1,X'0F'                                              10503133
         NI    BB3+1,X'0F'                                              10503134
         BC    15,DSED                                                  10503135
DSCHK    OI    AA3+1,X'F0'                                              10503136
         OI    BB3+1,X'F0'                                              10503137
DSED     STH   6,INFD         MODIFY INFD                               10503138
         BC    15,BA3                                                   10503139
DSRCK    TM    SWDP,X'02'     IS NEW RECORD                             10503140
         BC    8,DSST         NO, BRANCH TO DSST                        10503141
         BC    15,PRRCD       YES, BRANCH TO PRRCD                      10503142
HEX      LR    14,7           TRANSLATE INTO HEZADECIMAL                10503143
         MVI   DRCNO+7,X'0F'                                            10503144
         AR    7,7                                                      10503145
         BCTR  7,0                                                      10503146
         STC   7,DSTR+1                                                 10503147
         LH    7,INFD                                                   10503148
DSLP     SH    14,SVN         DOES FIELD REMAIN                         10503149
         BC    2,DSMVO        NO, BRANCH TO DSMVO                       10503150
         BC    8,DSHBC+4                                                10503151
         AH    14,SVN         YES, MODIFY FINAL UNPK                    10503152
         STC   14,DSUNPK+1                                              10503153
         BCTR  14,0                                                     10503154
         LA    14,112(14)                                               10503155
         STC   14,DSMVO+1                                               10503156
         IC    14,DSUNPK+1                                              10503157
         AR    14,14                                                    10503158
         BCTR  14,0                                                     10503159
         SLA   14,4                                                     10503160
         LA    14,7(14)                                                 10503161
         STC   14,DSUNPK+1                                              10503162
         NI    DSHBC+1,X'0F'                                            10503163
DSMVO    MVO   DRCNO(8),0(7,7)                                          10503164
DSUNPK   UNPK  20(14,11),DRCNO(8)                                       10503165
         LA    7,7(7)                                                   10503166
         LA    11,14(11)                                                10503167
DSHBC    BC    15,DSLP                                                  10503168
         OI    DSHBC+1,X'F0'                                            10503169
         MVI   DSMVO+1,X'76'                                            10503170
         MVI   DSUNPK+1,X'D7'                                           10503171
         LH    11,OTAREA                                                10503172
DSTR     TR    20(0,11),DSTBL-240                                       10503173
         LH    7,INFD                                                   10503174
         BC    15,DSMVC+6                                               10503175
DSWM     LH    7,HNDRD                                                  10503176
         OI    DSBC+1,X'F0'                                             10503177
         OI    AA3+1,X'F0'    SET INPUT NON EXHAUSTED                   10503178
         OI    BB3+1,X'F0'                                              10503179
         OI    DSBC+1,X'F0'                                             10503180
         BC    15,HEXBC                                                 10503181
SOS      AH    7,HNDRD        MODIFY INFD                               10503182
         STH   7,INFD                                                   10503183
         NI    SWDP,X'FD'     SET NEW RECORD OFF                        10503184
         BC    15,BA3                                                   10503185
*                                                                       10503186
***   SHIFT ROUTINE                                                     10503187
*                                                                       10503188
SHR      TM    TJOB,X'61'     IS LIST FIELD SELECT                      10503189
         BC    7,BA3          NO, BRANCH TO BA3                         10503190
         LA    7,RTN3         NO, BRANCH TO PHASE II                    10503191
         LH    11,UCLIM                                                 10503192
         BCR   15,11                                                    10503193
RTN3     BXLE  6,4,SSICHK     MODIFY INPUT LOGICAL RECORD ADDRESS       10503194
         NI    AA3+1,X'0F'                                              10503195
         NI    BB3+1,X'0F'                                              10503196
         BC    15,SSOCHK                                                10503197
SSICHK   OI    AA3+1,X'F0'                                              10503198
         OI    BB3+1,X'F0'                                              10503199
SSOCHK   BXLE  10,8,*+12      MODIFY OUTPUT LOGICAL RECORD ADDRESS      10503200
         NI    BA3+1,X'0F'                                              10503201
         BC    15,AK3                                                   10503202
         OI    BA3+1,X'F0'                                              10503203
*                                                                       10503204
***   AUXILIARY INPUT OPERATION                                         10503205
*                                                                       10503206
BA3      BC    15,AA3         IS OUTPUT AREA EXHAUSTED                  10503207
BB3      BC    0,BD3          IS INPUT AREA EXHAUSTED                   10503208
BB2      BC    0,BD3          IS 1-INPUT AREA                           10503209
         SVC   0              EXECUTE INPUT                             10503210
CHGI2    DC    YL2(CCBIB)                                               10503211
         OI    AB2+1,X'F0'                                              10503212
*                                                                       10503213
***   OUTPUT OPERATION                                                  10503214
*                                                                       10503215
BD3      BC    0,BD2          IS 1-OUTPUT AREA                          10503216
         BC    15,BH4                                                   10503217
         TM    2(3),X'80'     WAIT CARD OUTPUT                          10503218
         BC    8,*-4                                                    10503219
         TM    3(2),X'05'     WAIT PRINT OUTPUT                         10503220
         BC    8,*-4                                                    10503221
         BC    1,OEOV                                                   10503222
BF4      BC    15,CHGOM       CHANG OUTPUT LIST                         10503223
         MVC   OTAREA(2),OUTA                                           10503224
         MVC   OAREA(2),OUTB                                            10503225
         LA    2,CCBOB                                                  10503226
         STH   2,CHGO1                                                  10503227
         LA    3,CCBCB                                                  10503228
         STH   3,CHGC1                                                  10503229
         LH    10,OUTA                                                  10503230
         BC    15,CHGOX                                                 10503231
CHGOM    MVC   OTAREA(2),OUTB                                           10503232
         MVC   OAREA(2),OUTA                                            10503233
         LA    2,CCBOA                                                  10503234
         STH   2,CHGO1                                                  10503235
         LA    3,CCBCA                                                  10503236
         STH   3,CHGC1                                                  10503237
         LH    10,OUTB                                                  10503238
CHGOX    XI    BF4+1,X'F0'                                              10503239
         LR    9,10                                                     10503240
         AH    9,OBKSZ                                                  10503241
         BCTR  9,0                                                      10503242
         SVC   0              EXECUTE OUTPUT                            10503243
CHGO1    DC    YL2(CCBOA)                                               10503244
         SVC   0                                                        10503245
CHGC1    DC    YL2(CCBCA)                                               10503246
         BC    15,AA3                                                   10503247
BH4      NI    BD3+5,X'0F'                                              10503248
         BC    15,BF4                                                   10503249
BD2      SVC   0              EXECUTE OUTPUT                            10503250
CHGO2    DC    YL2(CCBOA)                                               10503251
         SVC   0                                                        10503252
CHGC2    DC    YL2(CCBCA)                                               10503253
         TM    2(3),X'80'     WAIT CARD OUTPUT                          10503254
         BC    8,*-4                                                    10503255
         TM    3(2),X'05'     WAIT PRINT OUTPUT                         10503256
         BC    8,*-4                                                    10503257
         BC    1,OEOV                                                   10503258
BG2      BC    15,CHGMO       CHANGE OUTPUT LIST                        10503259
         MVC   OTAREA(2),OUTA                                           10503260
         LA    2,CCBOA                                                  10503261
         STH   2,CHGO2                                                  10503262
         LA    3,CCBCA                                                  10503263
         STH   3,CHGC2                                                  10503264
         BC    15,CHGXO                                                 10503265
CHGMO    MVC   OTAREA(2),OUTB                                           10503266
         LA    2,CCBOB                                                  10503267
         STH   2,CHGO2                                                  10503268
         LA    3,CCBCB                                                  10503269
         STH   3,CHGC2                                                  10503270
CHGXO    XI    BG2+1,X'F0'                                              10503271
         LH    10,OUTA                                                  10503272
         BC    15,AA3                                                   10503273
*                                                                       10503274
**    SEQUENCE ERROR ROUTINE                                            10503275
*                                                                       10503276
SQOFF    NI    SQMVC+7,X'0F'                                            10503277
         BC    15,SQCHG                                                 10503278
SQERR    MVC   ISQMG+34(1),SQCURR                                       10503279
         MVC   ISQMG+54(1),SQLAST                                       10503280
         SVC   0              LOG MESSAGE                               10503281
         DC    YL2(CCBLG2)                                              10503282
         TM    CCBLG2+3,X'05'                                           10503283
         BC    8,*-4                                                    10503284
         BC    4,*+12         NON CHANNEL 12                            10503285
         MVI   BF4-3,X'F0'                                              10503286
         MVI   BG2-3,X'F0'                                              10503287
         NI    CCBLG2+2,X'7F'                                           10503288
         BC    15,SQCHG                                                 10503289
*                                                                       10503290
***   PRINT OUTPUT END OF PAGE ROUTINE                                  10503291
*                                                                       10503292
OEOV     TM    TJOB,X'10'     IS DATA DISPLAY                           10503293
         BC    1,PAGE         YES, BRANCH TO PAGE                       10503294
         TM    POPTN,X'01'    IS PAGE NO DEFINED                        10503295
         BC    1,PAGE         YES, BRANCH TO PAGE                       10503296
         SVC   0              SKIP TO CHANNEL 1                         10503297
         DC    YL2(CCBSK)                                               10503298
         TM    CCBSK+3,X'01'                                            10503299
         BC    8,*-4                                                    10503300
NWPG     TM    SWHD,X'FF'     IS HEADER LINE PROVIDED                   10503301
         BC    8,POE          NO, BRANCH TO POE                         10503302
         SVC   0              PRINT HEADER LINE                         10503303
         DC    YL2(CCBHD)                                               10503304
         TM    CCBHD+3,X'01'                                            10503305
         BC    8,*-4                                                    10503306
POE      TM    TJOB,X'10'     IS DATA DISPLAY                           10503307
         BC    8,EPOE         NO, BRANCH TO EPOE                        10503308
         MVC   SCLN+1(19),TTL                                           10503309
         MVC   CCWPG(1),CODE                                            10503310
         SVC   0                                                        10503311
         DC    YL2(CCBPG)                                               10503312
         TM    CCBPG+3,X'01'                                            10503313
         BC    8,*-4                                                    10503314
         MVI   CCWPG,X'89'                                              10503315
FTBC     BC    15,RST                                                   10503316
EPOE     TM    BD3+1,X'F0'    IS 1-OUTPUT AREA                          10503317
         MVI   BF4-3,X'10'                                              10503318
         MVI   BG2-3,X'10'                                              10503319
         BC    8,BF4          NO, BRANCH TO BF4                         10503320
         BC    15,BG2         YES, BRANCH TO BG2                        10503321
PAGE     MVC   SCLN+1(4),PG   SUPPLY PAGE AND NO                        10503322
         LH    7,PGNO                                                   10503323
         LA    7,1(7)                                                   10503324
         STH   7,PGNO                                                   10503325
         CVD   7,DRCNO                                                  10503326
         OI    DRCNO+7,X'0F'                                            10503327
         UNPK  SCLN+5(3),DRCNO(8)                                       10503328
         LA    7,SCLN+5                                                 10503329
         CLI   0(7),X'F0'                                               10503330
         BC    7,*+16                                                   10503331
         MVI   0(7),X'40'                                               10503332
         LA    7,1(7)                                                   10503333
         BC    15,*-16                                                  10503334
         SVC   0              PRINT PAGE AND SKIP TO CHANNEL 1          10503335
         DC    YL2(CCBPG)                                               10503336
         TM    CCBPG+3,X'01'                                            10503337
         BC    8,*-4                                                    10503338
         BC    15,NWPG                                                  10503339
RST      NI    FTBC+1,X'0F'                                             10503340
         NI    DPLY+1,X'0F'                                             10503341
         BC    15,DPLY+4                                                10503342
*                                                                       10503343
***   CARD INPUT END OF FILE ROUTINE                                    10503344
*                                                                       10503345
IEOV     TM    BA3+1,X'F0'    IS OUTPUT AREA EXHAUSTED                  10503346
         BC    8,IEMG         YES, BRANCH TO IEMG                       10503347
         SH    10,OTAREA                                                10503348
         STH   10,CCWOA+6     STORE COUNT AT COMMAND WORDS              10503349
         STH   10,CCWOB+6                                               10503350
         STH   10,CCWCA+6                                               10503351
         STH   10,CCWCB+6                                               10503352
         LH    7,BCR          GENERATE LINKAGE TO OUTPUT OPERATION      10503353
         STH   7,CHGC1+2                                                10503354
         STH   7,CHGC2+2                                                10503355
         LA    3,IEWT                                                   10503356
         BC    15,BD3                                                   10503357
BCR      BCR   15,3                                                     10503358
IEWT     TM    3(2),X'01'     WAIT OUTPUT                               10503359
         BC    8,*-4                                                    10503360
         TM    2(3),X'80'                                               10503361
         BC    8,*-4                                                    10503362
IEMG     SVC   0              LOG MESSAGE                               10503363
         DC    YL2(CCBLG3)                                              10503364
         TM    CCBLG3+3,X'01'                                           10503365
         BC    8,*-4                                                    10503366
         TM    POPTN,X'01'    IS PAGE REQUIRED                          10503367
         BC    1,*+12         YES, SKIP                                 10503368
         TM    TJOB,X'10'     IS DATA DISLPAY                           10503369
         BC    8,LST          NO, SKIP                                  10503370
         LH    7,BCR          GENERATE LINKAGE TO PAGE PRINTING         10503371
         STH   7,RST-4                                                  10503372
         LA    3,LST                                                    10503373
         BC    15,PAGE                                                  10503374
LST      SVC   0              MESSAGE TERMINATION                       10503375
         DC    YL2(CCBLG1)                                              10503376
         TM    CCBLG1+3,X'01'                                           10503377
         BC    8,*-4                                                    10503378
         SVC   1              TERMINATE JOB                             10503379
         DC    CL6'SYSEOJ'                                              10503380
*                                                                       10503381
***   CONSTANT                                                          10503382
*                                                                       10503383
AK3      EQU   BA3                                                      10503384
         CNOP  0,8                                                      10503385
REG      DS    CL40                                                     10503386
DRCNO    DC    C'        '                                              10503387
CCBSK    DC    X'00000400'                                              10503388
         DC    X'0008'                                                  10503389
         DC    YL2(CCWSK)                                               10503390
CCBHD    DC    X'000004000008'                                          10503391
         DC    YL2(CCWHD)                                               10503392
CCBPG    DC    X'00000400'                                              10503393
         DC    X'0008'                                                  10503394
         DC    YL2(CCWPG)                                               10503395
CCBIA    DC    X'00000000'                                              10503396
         DC    X'000C'                                                  10503397
         DC    YL2(CCWIA)                                               10503398
CCBIB    DC    X'00000000'                                              10503399
         DC    X'000C'                                                  10503400
         DC    YL2(CCWIB)                                               10503401
CCBOA    DC    X'00000400'                                              10503402
         DC    X'0008'                                                  10503403
         DC    YL2(CCWOA)                                               10503404
CCBOB    DC    X'00000400'                                              10503405
         DC    X'0008'                                                  10503406
         DC    YL2(CCWOB)                                               10503407
CCBCA    DC    X'00000000'                                              10503408
         DC    X'0010'                                                  10503409
         DC    YL2(CCWCA)                                               10503410
CCBCB    DC    X'00000000'                                              10503411
         DC    X'0010'                                                  10503412
         DC    YL2(CCWCB)                                               10503413
CCBLG1   DC    X'000004000014'                                          10503414
         DC    YL2(CCWLG1)                                              10503415
CCBLG2   DC    X'000004000014'                                          10503416
         DC    YL2(CCWLG2)                                              10503417
CCBEJ    DC    X'00000000'                                              10503418
         DC    X'0010'                                                  10503419
         DC    YL2(CCWEJ)                                               10503420
CCBLG3   DC    X'000004000008'                                          10503421
         DC    YL2(CCWLG3)                                              10503422
CCWIA    DC    X'0200000000000000'                                      10503423
CCWIB    DC    X'0200000000000000'                                      10503424
CCWOA    DC    X'0900000000000000'                                      10503425
CCWOB    DC    X'0900000000000000'                                      10503426
CCWSK    DC    X'8B00'                                                  10503427
         DC    YL2(BKNO)                                                10503428
         DC    X'00000001'                                              10503429
CCWLG1   DC    X'09'                                                    10503430
         DC    AL3(TMMG)                                                10503431
         DC    X'0000000B'                                              10503432
CCWLG2   DC    X'09'                                                    10503433
         DC    AL3(ISQMG)                                               10503434
         DC    X'00000040'                                              10503435
CCWLG3   DC    X'E1'                                                    10503436
         DC    AL3(MG3)                                                 10503437
         DC    X'0000000C'                                              10503438
CCWHD    DC    X'09'                                                    10503439
         DC    AL3(HEAD)                                                10503440
         DC    X'00000084'                                              10503441
CCWPG    DC    X'89'                                                    10503442
         DC    AL3(SCLN)                                                10503443
         DC    X'00000078'                                              10503444
CCWCA    DC    X'0100000000000000'                                      10503445
CCWCB    DC    X'0100000000000000'                                      10503446
CCWEJ    DC    X'8100'                                                  10503447
         DC    YL2(DRCNO)                                               10503448
         DC    X'40000001'                                              10503449
         DC    X'8100'                                                  10503450
         DC    YL2(DRCNO)                                               10503451
         DC    X'00000001'                                              10503452
ITAREA   DS    H                                                        10503453
OTAREA   DS    H                                                        10503454
OAREA    DS    H                                                        10503455
PGNO     DC    X'0000'                                                  10503456
RSCNT    DS    H                                                        10503457
BKNO     DC    X'0000'                                                  10503458
RCNO     DC    X'0000'                                                  10503459
HNDRD    DC    X'0032'                                                  10503460
SVN      DC    X'0007'                                                  10503461
SQCURR   DC    X'00000000000000000000'                                  10503462
SQLAST   DC    X'00000000000000000000'                                  10503463
TMMG     DC    C' END OF JOB'                                           10503464
ISQMG    DC    C' CARD SEQUENCE E'                                      10503465
         DC    C'RROR. CURRENT SE'                                      10503466
         DC    C'Q            LAS'                                      10503467
         DC    C'T SEQ           '                                      10503468
MG3      DC    C' END OF DATA'                                          10503469
CODE     DC    X'09'                                                    10503470
SWDP     DC    X'03'                                                    10503471
PG       DC    C'PAGE'                                                  10503472
TTL      DC    C'BL SZ  BL NO  RC'                                      10503473
         DC    C' NO'                                                   10503474
SCLN     DC    C'                '                                      10503475
         DC    C'    ....5....1..'                                      10503476
         DC    C'..5....2....5...'                                      10503477
         DC    C'.3....5....4....'                                      10503478
         DC    C'5....5....5....6'                                      10503479
         DC    C'....5....7....5.'                                      10503480
         DC    C'...8....5....9..'                                      10503481
         DC    C'..5.....'                                              10503482
         DS    CL12                                                     10503483
INFD     DS    H                                                        10503484
SORS     EQU   2500                                                     10503485
QORS     EQU   2504                                                     10503486
IRCLN    EQU   2508                                                     10503487
IBKSZ    EQU   2510                                                     10503488
ORCLN    EQU   2512                                                     10503489
OBKSZ    EQU   2514                                                     10503490
TPGM     EQU   2516                                                     10503491
TJOB     EQU   2517                                                     10503492
FRCD     EQU   2518                                                     10503493
DOPTN    EQU   2519                                                     10503494
POPTN    EQU   2520                                                     10503495
LABSW    EQU   2521                                                     10503496
ICU      EQU   2522                                                     10503497
OCU      EQU   2523                                                     10503498
IBKC     EQU   2524                                                     10503499
OBKC     EQU   2528                                                     10503500
LABIH    EQU   2532                                                     10503501
LABOH    EQU   2534                                                     10503502
LABIT    EQU   2536                                                     10503503
LABOT    EQU   2538                                                     10503504
LABOR    EQU   2540                                                     10503505
AAST     EQU   2542                                                     10503506
LABRTN   EQU   2544                                                     10503507
IPA      EQU   2546                                                     10503508
OPA      EQU   2548                                                     10503509
INA      EQU   2550                                                     10503510
INB      EQU   2552                                                     10503511
OUTA     EQU   2554                                                     10503512
OUTB     EQU   2556                                                     10503513
UCLIM    EQU   2558                                                     10503514
SWHD     EQU   2560                                                     10503515
NOIO     EQU   2561                                                     10503516
HEAD     EQU   2562                                                     10503517
DSTBL    EQU   2706                                                     10503518
LAST     DS    H                                                        10503519
         ORG   LAST+150                                                 10503520
*                                                                       10503521
***   INITIALIZATION                                                    10503522
*                                                                       10503523
STAT     TM    DOPTN,X'10'    IS BINARY READING                         10503524
         BC    8,*+12         NO, SKIP                                  10503525
         OI    CCWIA,X'20'    YES, MODIFY COMMAND CODE                  10503526
         OI    CCWIB,X'20'                                              10503527
         TM    DOPTN,X'01'    IS BINARY OUTPUT                          10503528
         BC    8,*+12         NO, BRANCH                                10503529
         MVI   CCWCA,X'21'    YES, MODIFY COMMAND CODES                 10503530
         MVI   CCWCB,X'21'                                              10503531
         TM    POPTN,X'40'    IS TRIPLE SPACE                           10503532
         BC    8,INTT         NO, BRANCH TO INTT                        10503533
         MVI   CCWOA,X'19'    YES, MODIFY COMMAND CODES                 10503534
         MVI   CCWOB,X'19'                                              10503535
         MVI   CCWHD,X'19'                                              10503536
         MVI   CCWHD,X'19'                                              10503537
         MVI   CCWLG2,X'19'                                             10503538
         MVI   CODE,X'19'                                               10503539
         BC    15,INT                                                   10503540
INTT     TM    POPTN,X'20'    IS DOUBLE SPACE                           10503541
         BC    8,INT          NO, BRANCH TO INT                         10503542
         MVI   CCWOA,X'11'    YES, MODIFY COMMAND CODES                 10503543
         MVI   CCWOB,X'11'                                              10503544
         MVI   CCWLG2,X'11'                                             10503545
         MVI   CCWHD,X'11'                                              10503546
         MVI   CODE,X'11'                                               10503547
INT      LH    1,IBKSZ        STORE COUNT AT COMMAND WORDS              10503548
         STH   1,CCWIA+6                                                10503549
         STH   1,CCWIB+6                                                10503550
         LH    1,OBKSZ                                                  10503551
         STH   1,CCWOA+6                                                10503552
         STH   1,CCWOB+6                                                10503553
         STH   1,CCWCA+6                                                10503554
         STH   1,CCWCB+6                                                10503555
         MVC   CCWIA+2(2),INA STORE STARTING ADDRESS AT COMMAND WORDS   10503556
         MVC   CCWIB+2(2),INB                                           10503557
         MVC   CCWOA+2(2),OUTA                                          10503558
         MVC   CCWOB+2(2),OUTB                                          10503559
         MVC   CCWCA+2(2),OUTA                                          10503560
         MVC   CCWCB+2(2),OUTB                                          10503561
         LA    1,CCBIA        SET INPUT CCB FOR AREA A                  10503562
         LA    2,CCBOA        SET OUTPUT CCB FOR AREA A                 10503563
         LA    3,CCBCA        SET OUTPUT CCB FOR AREA A                 10503564
         LH    4,IRCLN        SET REGISTER 4,5,6                        10503565
         LH    5,INA                                                    10503566
         STH   5,ITAREA                                                 10503567
         STH   5,INFD                                                   10503568
         LR    6,5                                                      10503569
         AH    5,IBKSZ                                                  10503570
         BCTR  5,0                                                      10503571
         LH    8,ORCLN        SET REGISTER 8,9,10                       10503572
         LH    9,OUTA                                                   10503573
         STH   9,OTAREA                                                 10503574
         LR    10,9                                                     10503575
         AH    9,OBKSZ                                                  10503576
         BCTR  9,0                                                      10503577
         TM    TJOB,X'0F'     IS CARD OUTPUT ONLY                       10503578
         BC    8,PNT                                                    10503579
         LH    2,NOP                                                    10503580
         STH   2,BD3+16                                                 10503581
         STH   2,BD3+20                                                 10503582
         STH   2,BD3+24                                                 10503583
         STH   2,BF4+14                                                 10503584
         STH   2,CHGOM+10                                               10503585
         STH   2,CHGO1-2                                                10503586
         STH   2,BD2                                                    10503587
         STH   2,CHGC2+10                                               10503588
         STH   2,CHGC2+14                                               10503589
         STH   2,CHGC2+18                                               10503590
         STH   2,BG2+14                                                 10503591
         STH   2,CHGMO+10                                               10503592
         STH   2,IEWT                                                   10503593
         STH   2,IEWT+4                                                 10503594
         MVC   IEWT(2),*+10                                             10503595
         BC    15,SET1                                                  10503596
         BC    15,LST                                                   10503597
PNTT     LH    3,NOP                                                    10503598
         STH   3,BD3+8                                                  10503599
         STH   3,BD3+12                                                 10503600
         STH   3,CHGOM-12                                               10503601
         STH   3,CHGOX-8                                                10503602
         STH   3,CHGC1-2                                                10503603
         STH   3,CHGC2-2                                                10503604
         STH   3,CHGC2+2                                                10503605
         STH   3,CHGC2+6                                                10503606
         STH   3,CHGMO-8                                                10503607
         STH   3,CHGXO-4                                                10503608
         STH   3,IEWT+8                                                 10503609
         STH   3,IEWT+12                                                10503610
         BC    15,SET                                                   10503611
NOP      BC    0,NOP+4                                                  10503612
PNT      SVC   0              SKIP TO CHANNEL 1                         10503613
         DC    YL2(CCBSK)                                               10503614
         TM    CCBSK+3,X'01'                                            10503615
         BC    8,*-4                                                    10503616
         TM    SWHD,X'FF'     IS HEADER LINE                            10503617
         BC    8,PT1          NO, BRANCH                                10503618
         TM    TJOB,X'10'     IS DATA DISPLAY                           10503619
         BC    1,PT1          YES, BRANCH                               10503620
         SVC   0              PRINT HEADER LINE                         10503621
         DC    YL2(CCBHD)                                               10503622
         TM    CCBHD+3,X'01'                                            10503623
         BC    8,*-4                                                    10503624
PT1      TM    TJOB,X'C0'     IS PRINT ONLY                             10503625
         BC    8,PNTT                                                   10503626
SET1     LH    7,22           STORE THE ADDRESS OF PUB                  10503627
         TM    18(7),X'08'    IS 1402 OUTPUT                            10503628
         BC    1,SET          YES, BRANCH TO SET                        10503629
SET2     SVC   0              EJECT CARD                                10503630
         DC    YL2(CCBEJ)                                               10503631
         TM    CCBEJ+2,X'80'                                            10503632
         BC    8,*-4                                                    10503633
         OI    CCWCA,X'C1'                                              10503634
         OI    CCWCB,X'C1'                                              10503635
SET      TM    DOPTN,X'04'    IS HEXADECIMAL                            10503636
         BC    1,TDD          YES, SKIP INSTRUCTIONS                    10503637
         LH    7,HNDRD        NO, MODIFY HNDRD                          10503638
         AR    7,7                                                      10503639
         STH   7,HNDRD                                                  10503640
         NI    HEXBC+1,X'0F'                                            10503641
TDD      TM    TJOB,X'10'     IS LIST OR FIELD SELECT                   10503642
         BC    1,*+10         NO, SKIP LINE                             10503643
         XC    SCLN(132),SCLN ERASE SCALE LINE                          10503644
         SR    7,7                                                      10503645
         A     7,QORS         IS SEQUENCE CHECK SPECIFIED               10503646
         BC    8,SSR          NO, BRANCH TO SSR                         10503647
         MVC   SQMVC+5(1),QORS+1                                        10503648
         LH    7,QORS+2                                                 10503649
         BCTR  7,0                                                      10503650
         STC   7,SQMVC+1                                                10503651
         STC   7,SQERR+1                                                10503652
         STC   7,SQERR+7                                                10503653
         NI    AG3+1,X'0F'                                              10503654
*                                                                       10503655
***   SETTING SWITCH ROUTINE                                            10503656
*                                                                       10503657
SSR      TM    TJOB,X'61'     IS LIST, COPY OR BOTH                     10503658
         BC    8,IOSC11       NO, BRANCH TO IOSC11                      10503659
         OI    AB3+1,X'F0'                                              10503660
         NI    BA3+1,X'0F'                                              10503661
         OI    BD3+1,X'F0'                                              10503662
         TM    NOIO,X'01'     IS 1-INPUT-OUTPUT AREA                    10503663
         BC    8,STSR         NO, BRANCH TO STSR                        10503664
         OI    BB3+1,X'F0'                                              10503665
         BC    15,AAA                                                   10503666
STSR     NI    BB3+1,X'0F'    NO, 2-INPUT-OUTPUT AREAS                  10503667
         NI    BB2+1,X'0F'                                              10503668
         BC    15,AAA                                                   10503669
IOSC11   TM    NOIO,X'11'     ARE 1-INPUT 1-OUTPUT AREAS                10503670
         BC    12,IOSC12      NO, BRANCH TO IOSC12                      10503671
         OI    AB3+1,X'F0'                                              10503672
         OI    BD3+1,X'F0'                                              10503673
         NI    BB2+1,X'0F'                                              10503674
         BC    15,AAA                                                   10503675
IOSC12   TM    NOIO,X'12'     ARE 1-INPUT 2-OUTPUT AREAS                10503676
         BC    12,IOSC21      NO, BRANCH TO IOSC21                      10503677
         OI    AB3+1,X'F0'                                              10503678
         NI    BB2+1,X'0F'                                              10503679
         NI    BD3+1,X'0F'                                              10503680
         BC    15,AAA                                                   10503681
IOSC21   MVI   ISVC,X'0A'                                               10503682
         NI    AB3+1,X'0F'                                              10503683
         OI    BB2+1,X'F0'                                              10503684
         TM    NOIO,X'21'     ARE 2-INPUT 1-OUTPUT AREAS                10503685
         BC    12,IOSC22      NO, BRANCH TO IOSC22                      10503686
         OI    BD3+1,X'F0'                                              10503687
         BC    15,AAA                                                   10503688
IOSC22   NI    BD3+1,X'0F'                                              10503689
         BC    15,AAA                                                   10503690
         END   STRT                                                     10503691
