        CATALS   Z.MCR1,28.0
        BKEND   Z.MCR1
L477     TITLE 'MCR1 SAMPLE PROBLEM'                                    L4770001
         PRINT NOGEN                                                    L4770002
START    BALR 4,0                                                       L4770003
         USING *,4                                                      L4770004
         OPEN  FILE1,FILE         OPEN ALL FILES                        L4770005
         L     DOCNT,TOTDOC       INITIALIZE DOCUMENT COUNTER           L4770006
NEXT     GET   FILE               GET DOCUMENT FROM MICR DEVICE         L4770007
         TM    0(2),X'20'         UNRECOVERABLE I/O ERRORS              L4770008
         BO    EOJ                YES, TERMINATE                        L4770009
         TM    DISSW,X'01'        DISENGAGE                             L4770010
         BO    DISENG             YES                                   L4770011
DISCOM   TM    0(2),X'10'         READY FOR POCKET LIGHT                L4770012
         BO    LITE               YES                                   L4770013
         TM    0(2),X'08'    IF INT. REQD., RE-ISSUE GET                L4770014
         BO    NEXT                                                     L4770015
LASDOC   BCT   DOCNT,MVC          DECREMENT DOCUMENT COUNTER            L4770016
         B     EOF                                                      L4770017
MVC      MVC   AREA1(10),86(2)    MOVE DATA TO OUTPUT AREA              L4770018
         PUT   FILE1,STLSP=BKT    PRINT                                 L4770019
* OMIT 'STLSP=BKT' PARAMETER IF SELECTIVE TAPE LIST FEATURE NOT PRESENT L4770020
         B     NEXT                                                     L4770021
DISENG   DISEN FILE               DISENGAGE MICR DEVICE                 L4770022
         MVI   CTR+1,X'30'        REINITIALIZE DOCUMENT COUNTER         L4770023
         MVI   DISSW,X'00'        RESET DISENGAGE SWITCH                L4770024
         B     DISCOM                                                   L4770025
LITE     EQU   *                                                        L4770026
         LITE  FILE,SWAREA        LIGHT POCKET SPECIFIED IN SWAREA      L4770027
*        REMOVE ABOVE STATEMENT IF POCKET LIGHT FEATURE IS ABSENT       L4770028
         B     LASDOC                                                   L4770029
EOF      MVC   DISCOM+6(2),EOJADD ALTER EOJ BRANCH                      L4770030
         B     DISENG                                                   L4770031
EOJADD   DC    S(EOJ)             EOJ ADCON                             L4770032
EOJ      CLOSE FILE1,FILE         CLOSE ALL FILES                       L4770033
         EOJ                                                            L4770034
*                                                                       L4770035
*        STACKER SELECTION ROUTINE                                      L4770036
*                                                                       L4770037
         USING *,5                                                      L4770038
USSR     MVI   4(7),X'3F'         ARBITRARILY SELECT POCKET THREE       L4770039
         IC    2,CTR+1            DECREMENT DOCUMENT COUNTER            L4770040
         BCT   2,NODIS                                                  L4770041
         OI    DISSW,X'01'        TURN ON DISENGAGE SWITCH              L4770042
         OI    1(7),X'80'         UPDATE BATCH NUMBERER                 L4770043
*        REMOVE ABOVE STATEMENT IF BATCH NUMBERING NOT AVAILABLE        L4770044
NODIS    STC   2,CTR+1                                                  L4770045
         EXIT  MR                                                       L4770046
         DROP  5                                                        L4770047
*                                                                       L4770048
FILE     DTFMR BUFFERS=100,                                            XL4770049
               EXTADDR=USSR,                                           XL4770050
               IOAREA1=AREA,                                           XL4770051
               DEVADDR=SYS005,                                         XL4770052
               RECSIZE=80,                                             XL4770053
               IOREG=2,                                                XL4770054
               ADDRESS=DUAL,      REMOVE IF DUAL ADAPTER NOT PRESENT   XL4770055
               SECADDR=SYS006,    REMOVE IF DUAL ADAPTER NOT PRESENT   XL4770056
               ADDAREA=10                                               L4770057
         MRMOD ADDRESS=DUAL,BUFFERS=100                                 L4770058
*        IF DUAL ADDRESSING ADAPTER FEATURE IS ABSENT,                  L4770059
*        REMOVE (ADDRESS=DUAL) PARAMETER FROM THE ABOVE STATEMENT.      L4770060
FILE1    DTFPR DEVADDR=SYS009,                                         XL4770061
               STLIST=YES, REMOVE IF NO SELECTIVE TAPE FEATURE PRESENT XL4770062
               IOAREA1=AREA1                                            L4770063
         PRMOD                                                         XL4770064
               STLIST=YES, REMOVE IF NO SELECTIVE TAPE FEATURE PRESENT XL4770065
               RECFORM=FIXUNB                                           L4770066
         LTORG                                                          L4770067
DOCNT    EQU   5                  DOCUMENT COUNTER                      L4770068
AREA1    DC    121CL1' '          OUTPUT AREA                           L4770069
BKT      DC    X'01'              SELECTIVE TAPE LISTER TAPE INDICATOR  L4770070
CTR      DC    H'48'              DOCUMENT COUNTER                      L4770071
SWAREA   DC    X'0400'            POCKET SELECTION FOR POCKET LIGHTING  L4770072
DISSW    DC    X'00'              DISENGAGE SWITCH                      L4770073
TOTDOC   DC    F'500'             TOTAL NO. OF DOCUMENTS TO BE READ     L4770074
AREA     DS    CL9600             MICR INPUT AREA                       L4770075
   END      START                                                       L4770076
        BKEND
        CATALS   Z.MCR2,28.0
        BKEND   Z.MCR2
$477     TITLE 'MCR2 SAMPLE PROBLEM'                                    $4770001
         PRINT NOGEN                                                    $4770002
START    BALR  4,0                                                      $4770003
         USING *,4                                                      $4770004
         OPEN  FILE1,FILE2,FILE3,FILE4 OPEN ALL FILES                   $4770005
         L     DOCNT1,TOTDOC      INITIALIZE FILE1 DOCUMENT COUNTER     $4770006
         LR    DOCNT2,DOCNT1      INITIALIZE FILE2 DOCUMENT COUNTER     $4770007
NEXT     READ  FILE1,MR            GET DOCUMENT FROM FIRST MICR DEVICE  $4770008
         CHECK FILE1,NEXT1        IS DOCUMENT READY FOR PROCESSING      $4770009
         BCT   DOCNT1,MVC1        DECREMENT DOCUMENT COUNTER FOR FILE1  $4770010
         DISEN FILE1              DISENGAGE FILE1                       $4770011
MVC1     MVC   AREA(10),16(2)     MOVE DATA TO OUTPUT AREA              $4770012
         PUT   FILE3,STLSP=CNTAD1 PRINT                                 $4770013
* OMIT 'STLSP=CNTAD1' PARAMETER IF NO SELECTIVE TAPE FEATURE            $4770014
NEXT1    READ  FILE2,MR           GET DOCUMENT FROM SECOND MICR DEVICE  $4770015
         CHECK FILE2,NEXT2        IS DOCUMENT READY FOR PROCESSING      $4770016
         BCT   DOCNT2,MVC2        DECREMENT DOCUMENT COUNTER FOR FILE2  $4770017
         DISEN FILE2              DISENGAGE FILE2                       $4770018
MVC2     MVC   PRNTAR(100),6(3)   MOVE DATA TO OUTPUT AREA              $4770019
         PUT   FILE4              PRINT                                 $4770020
NEXT2    WAITF FILE1,FILE2        ANY MICR FILES ACTIVE                 $4770021
         B     NEXT               YES                                   $4770022
ERROUT1  LR    14,0               INITIALIZE RETURN REGISTER            $4770023
         TM    0(2),X'30' UNRECOVERABLE I/O ERROR OR ALL DOCS PROCESSED $4770024
         BNZ   CLOSE1             YES                                   $4770025
         BR    14                 RETURN TO NEXT READ                   $4770026
ERROUT2  LR    RETURN,0           INITIALIZE RETURN REGISTER            $4770027
         TM    0(3),X'30' UNRECOVERABLE I/O ERROR OR ALL DOCS PROCESSED $4770028
         BNZ   CLOSE2             YES                                   $4770029
         TM    0(3),X'08'         INTERVENTION REQUIRED                 $4770030
         BCR   14,RETURN          NO                                    $4770031
         PUT   MSGWRT                                                   $4770032
         BR    RETURN                                                   $4770033
CLOSE1   CLOSE FILE1              CLOSE FILE1                           $4770034
         OI    CLOSID,X'01'       SET FILE1 CLOSED INDICATOR            $4770035
         B     ENDTST                                                   $4770036
CLOSE2   CLOSE FILE2              CLOSE FILE2                           $4770037
         OI    CLOSID,X'02'       SET FILE2 CLOSED INDICATOR            $4770038
ENDTST   TM    CLOSID,X'03'       BOTH FILES CLOSED                     $4770039
         BNO   NEXT               NO                                    $4770040
         CLOSE FILE3,FILE4        CLOSE PRINTER FILES                   $4770041
         EOJ                                                            $4770042
*                                                                       $4770043
*        STACKER SELECTION ROUTINE FOR FILE1                            $4770044
*                                                                       $4770045
         USING *,5                                                      $4770046
USSR1    TM    2(7),X'0C'         DATA CHECK OR OVERRUN                 $4770047
         BNZ   DERR1              YES                                   $4770048
         CLC   BLANK(10),16(7)    IS FIELD BLANK                        $4770049
         BNE   PKT1               NO                                    $4770050
         MVI   4(7),X'0F'         SELECT POCKET ZERO                    $4770051
         B     EXIT1                                                    $4770052
PKT1     MVI   4(7),X'1F'         SELECT POCKET ONE                     $4770053
         B     EXIT1                                                    $4770054
DERR1    MVI   4(7),X'CF'         SELECT REJECT POCKET                  $4770055
EXIT1    EXIT  MR                                                       $4770056
*                                                                       $4770057
*        STACKER SELECTION ROUTINE FOR FILE2                            $4770058
*                                                                       $4770059
         USING *,5                                                      $4770060
USSR2    TM    2(7),X'0C'         DATA CHECK OR OVERRUN                 $4770061
         BNZ   REJECT             YES                                   $4770062
         CLI   98(7),X'F9'                                              $4770063
         BH    REJECT             IS DATA A DIGIT                       $4770064
         CLI   98(7),X'F0'                                              $4770065
         BL    REJECT                                                   $4770066
         PACK  4(1,7),98(1,7)     SELECT POCKET ACCORDING DIGIT ON DOC. $4770067
         B     EXIT2                                                    $4770068
REJECT   MVI   4(7),X'CF'         SELECT REJECT POCKET                  $4770069
EXIT2    EXIT  MR                                                       $4770070
         DROP  5                                                        $4770071
*                                                                       $4770072
FILE1    DTFMR DEVADDR=SYS005,                                         X$4770073
               ADDRESS=DUAL, REMOVE IF DUAL ADDRESSING ADAPTER ABSENT  X$4770074
               ADDAREA=0,                                              X$4770075
               IOREG=2,                                                X$4770076
               IOAREA1=AREA1,                                          X$4770077
               RECSIZE=20,                                             X$4770078
               ERROPT=ERROUT1,                                         X$4770079
               EXTADDR=USSR1,                                          X$4770080
               SECADDR=SYS006, REMOVE IF DUAL ADDRESS ADAPTER ABSENT   C$4770081
               BUFFERS=100                                              $4770082
FILE2    DTFMR DEVADDR=SYS007,                                         X$4770083
               ADDRESS=DUAL, REMOVE IF DUAL ADDRESSING ADAPTER ABSENT  X$4770084
               RECSIZE=80,                                             X$4770085
               IOAREA1=AREA2,                                          X$4770086
               IOREG=3,                                                X$4770087
               ADDAREA=20,                                             X$4770088
               BUFFERS=100,                                            X$4770089
               ERROPT=ERROUT2,                                         X$4770090
               SECADDR=SYS008, REMOVE IF DUAL ADDRESS ADAPTER ABSENT   C$4770091
               EXTADDR=USSR2                                            $4770092
FILE3    DTFPR DEVADDR=SYS009,                                         X$4770093
               STLIST=YES, REMOVE IF NO SELECTIVE TAPE FEATURE PRESENT X$4770094
               IOAREA1=AREA                                             $4770095
FILE4    DTFPR DEVADDR=SYSLST,                                         X$4770096
               IOAREA1=PRNTAR                                           $4770097
         MRMOD ADDRESS=DUAL,BUFFERS=100                                 $4770098
*        REMOVE (ADDRESS=DUAL) PARAMETER FROM THE ABOVE STATEMENT.      $4770099
*        IF DUAL ADDRESSING ADAPTER FEATURE IS ABSENT,                  $4770100
         PRMOD                                                         X$4770101
               STLIST=YES,        REMOVE IF NO SELECTIVE TAPE FEATURE  X$4770102
               RECFORM=FIXUNB                                           $4770103
         PRMOD RECFORM=FIXUNB                                           $4770104
MSGWRT   DTFCN BLKSIZE=32,DEVADDR=SYSLOG,IOAREA1=MESSG,TYPEFLE=OUTPUT   $4770105
         LTORG                                                          $4770106
DOCNT1   EQU   5                  DOCUMENT COUNTER FOR FILE1            $4770107
DOCNT2   EQU   6                  DOCUMENT COUNTER FOR FILE2            $4770108
RETURN   EQU   10                                                       $4770109
MESSG    DC    C' INTERVENTION REQUIRED ON FILE2 '                      $4770110
CNTAD1   DC    X'01'              SELECTIVE TAPE LIST TAPE INDICATOR    $4770111
CLOSID   DC    X'00'              CLOSED INDICATOR                      $4770112
BLANK    DC    10X'00'                                                  $4770113
TOTDOC   DC    F'250'             TOTAL NO. OF DOCUMENTS TO BE READ     $4770114
AREA     DC    140C' '            OUTPUT AREA FOR FILE3                 $4770115
PRNTAR   DC    140C' '            OUTPUT AREA FOR FILE4                 $4770116
AREA1    DS    CL2600             INPUT AREA FOR FILE1                  $4770117
AREA2    DS    CL10600            INPUT AREA FOR FILE2                  $4770118
         END   START                                                    $4770119
        BKEND
        CATALS   Z.SAMP327L,0.0
        BKEND   Z.SAMP327L
         PUNCH ' PHASE SAMP327L,* '                                     00020000
SAMP327L CSECT                                                          00100000
         SPACE 5                                                        00150000
*        THIS IS A SAMPLE PROBLEM FOR A LOCAL 3270 INFORMATION DISPLAY  00200000
*  SYSTEM.  PLEASE NOTE THAT THIS PROGRAM HAS BEEN WRITTEN FOR TWO      00250000
*  3270 DEVICES, AT LEAST ONE OF WHICH MUST BE A 3277 DISPLAY.          00300000
*                                                                       00350000
*        TO ASSEMBLE THIS SAMPLE PROBLEM, FIRST REMOVE ALL CATALS AND   00400000
*  BKEND CARDS, AND THEN PUNCH AND INSERT THE NECESSARY JOB CONTROL     00450000
*  CARDS FOR AN ASSEMBLY.                                               00500000
*                                                                       00550000
*        NOW THE OUTPUT FROM THE ASSEMBLER (THE OBJECT DECK) MUST BE    00600000
*  LINKAGE-EDITED TO THE CORE IMAGE LIBRARY IN THE DESIRED PARTITION.   00650000
*                                                                       00750000
*        THE FOLLOWING I/O ASSIGNMENTS MUST BE MADE TO ASSOCIATE THE    00800000
*  3270 DEVICES WITH THE PROGRAM:                                       00850000
*                            // ASSGN SYS005,X'CUU'                     00900000
*                            // ASSGN SYS006,X'CUU'                     00950000
*                                                                       01000000
*        TO EXECUTE THIS SAMPLE PROGRAM, ENTER FROM THE OPERATORS       01050000
*  CONSOLE OR THROUGH THE CARD READER THE FOLLOWING:                    01100000
*                           // EXEC SAMP327L                            01150000
*                                                                       01200000
*        IT MAY BE NECESSARY TO ALTER THIS SAMPLE PROBLEM SO THAT IT    01250000
*  MAY FUNCTION WITH MORE THAN TWO DEVICES.  TO DO SO, THE FOLLOWING    01300000
*  CARDS MUST BE CHANGED IN THE SOURCE DECK:                            01350000
*                           1. DTFBT MACRO (LINELST OPERAND)            01400000
*                           2. RMSRTAB MACRO                   @DA10721 01450000
*                                                                       01500000
*        THIS SAMPLE PROGRAM IS RESTRICTED TO A MAXIMUM OF 32 DEVICES,  01550000
*  ALL OF WHICH MUST BE ATTACHED TO ONE LOCAL 3272 CONTROL UNIT.        01600000
*                                                                       01607000
***************************  APARS FIXED  ***************************** 01614000
*                                                                     * 01621000
*   DM16465, DA10721, DA10722, DA10723, DA13032                       * 01628000
*                                                                     * 01635000
*********************************************************************** 01642000
         EJECT                                                          01650000
*        REGISTER EQUATES                                               01700000
REGZERO  EQU   0                   REGISTER 0                           01750000
REG2     EQU   2                   WORK REGISTER                        01800000
LCBREG   EQU   3                   LCB ADDRESS                          01850000
WORKREG  EQU   3                   WORK REGISTER                        01900000
MSGADDR  EQU   4                   ADDR OF OUTPUT MESSAGE               01950000
MSGLEN   EQU   5                   LENGTH OF OUTPUT MESSAGE             02000000
RLNREG   EQU   6                   RELATIVE LINE NUMBER                 02050000
DTFREG   EQU   7                   DTFBT ADDRESS                        02100000
FMTREG   EQU   8                   FORMAT IDENTIFIER                    02150000
DSPTABRG EQU   9                   ADDRESS OF DISPLAY TABLE             02200000
LNKREG   EQU   10                  LINKAGE REGISTER                     02250000
BASEREG  EQU   11                  FIRST BASE REG                       02300000
BASEREG2 EQU   12                  SENOND BASE REG                      02350000
PTRTAB   EQU   13                  PRINTER RLN TABLE ADDRESS            02400000
RTNCDRG  EQU   15                  RETURN CODE REGISTER                 02450000
REG15    EQU   15                  REGISTER 15                          02500000
         SPACE 5                                                        02550000
*        EQUATES                                                        02600000
ZERO     EQU   0                   LENGTH OF 0                          02650000
PTR3270  EQU   1                   LCB PRINTER INDICATOR FLAG           02700000
ONE      EQU   1                   LENGTH OF 1                          02750000
TWO      EQU   2                   LENGTH OF 2                          02800000
FOUR     EQU   4                   FORMAT 1 IDENTIFIER                  02850000
EIGHT    EQU   8                   FORMAT 2 IDENTIFIER                  02900000
PTRFLAG  EQU   16                  DISP TO PRINTER FLAG IN LCB          02950000
EIGTEEN  EQU   18                  DISP INTO DECB FOR RESIDUAL COUNT    03000000
THRTY9   EQU   39                  DISP INTO DECB FOR POLLING POINTER   03050000
DTFLEN   EQU   40                  DTFBT LENGTH                         03100000
LCBLEN   EQU   72                  LCB LENGTH                  @DA13032 03150000
FOURTY2  EQU   X'42'               RFT RECEIVED COMP CODE               03200000
SIXTY4   EQU   X'64'               DEVICE BUFFER CLOBERED COMP CODE     03250000
PA1      EQU   X'6C'               ATTENTION ID FOR PA1 KEY             03300000
CLEAR    EQU   X'6D'               ATTENTION ID FOR CLEAR KEY           03350000
PA2      EQU   X'6E'               ATTENTION ID FOR PA2 (CNCL) KEY      03400000
ENTER    EQU   X'7D'               ATTENTION ID FOR ENTER KEY           03450000
SEVENF   EQU   X'7F'               NORMAL COMPLETION CODE               03500000
LASTLCB  EQU   X'80'               LAST LCB INDICATOR                   03550000
PRINTER  EQU   X'80'               PRINTER IS DEFINED                   03600000
PRNTWCC  EQU   X'D8'               WCC WITH START PRINT BIT ON          03650000
HEXFF    EQU   X'FF'               HEX CONSTANT OF 255                  03700000
         EJECT                                                          03750000
BASE     BALR  BASEREG,0           ESTABLISH                   @DA10722 03800000
         USING *,BASEREG,BASEREG2            ADDRESSABILITY             03850000
         LR    BASEREG2,BASEREG    INITIALIZE                           03900000
         AH    BASEREG2,H4096                 SECOND BASE               03950000
*        OPEN THE LINE GROUP                                            04000000
         OPEN  DTFBTL                                                   04050000
         SR    RLNREG,RLNREG       CLEAR RLN REG                        04100000
         L     DTFREG,VDTF         ADDRESS THE DTFBT                    04150000
         LA    LCBREG,DTFLEN(DTFREG) ADDRESS FIRST LCB                  04200000
         LA    PTRTAB,PTRRLNTB     ADDRESS THE PRINTER TABLE            04250000
         LA    DSPTABRG,DSPTAB     ADDRESS THE DISPLAY TABLE            04300000
CHECKPTR EQU   *                                                        04350000
         TM    PTRFLAG(LCBREG),PTR3270  DEVICE A PRINTER                04400000
         BNO   INITIAL             NO, WRITE INITIAL MESSAGE            04450000
         OI    FLAGS,PRINTER       SET PRINTER DEFINED FLAG             04500000
         ST    PTRTAB,CURRPTR      SAVE POINTER TO CURRENT PTR RLN      04550000
         STC   RLNREG,ZERO(PTRTAB) STORE PRINTER RLN                    04600000
         LA    PTRTAB,ONE(PTRTAB)  ADDR NEXT ENTRY IN PTR TABLE         04650000
LCBUPDT  EQU   *                                                        04700000
         LA    RLNREG,ONE(RLNREG)  GET NEXT RLN                         04750000
         TM    PTRFLAG(LCBREG),LASTLCB  LAST LCB                        04800000
         BO    INITIAL             YES, GO WRITE WITH INVALID RLN       04850000
         LA    LCBREG,LCBLEN(LCBREG) ADDR NEXT LCB                      04900000
         B     CHECKPTR            CHECK NEXT DEVICE                    04950000
INITIAL   EQU  *                                                        05000000
         LA    MSGADDR,FORMAT0     ADDR OF FORMAT0 MESSAGE              05050000
         LA    MSGLEN,FMT0SZ       LENGTH OF MESSAGE                    05100000
         BAL   LNKREG,WRITETS      GO WRITE FORMAT 0                    05150000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    05200000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  05250000
         B     LCBUPDT             UPDATE LCB POINTER                   05300000
READ     EQU   *                                                        05350000
         XC    INAREA(256),INAREA    CLEAR INPUT               @DA10721 05400000
         XC    INAREA+256(44),INAREA             AREA          @DA10721 05450000
         IC    RLNREG,RLNREAD      GET RLN OF LAST DEVICE READ          05500000
         LA    RLNREG,ONE(RLNREG)  GET NEXT RLN                         05550000
         CH    RLNREG,MAXRLN       HAVE WE EXCEEDED MAX RLN             05600000
         BNL   RLNZERO             YES, USE RLN OF 0                    05650000
         B     GOREAD              NO, GO ISSUE THE READ                05700000
RLNZERO  EQU   *                                                        05750000
         SR    RLNREG,RLNREG       GET RLN OF 0                         05800000
GOREAD   EQU   *                                                        05850000
         BAL   LNKREG,READTI       GO READ A DISPLAY                    05900000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    05950000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  06000000
         IC    RLNREG,DECBD+THRTY9 GET RLN OF DEVICE JUST READ          06050000
         STC   RLNREG,RLNREAD      SAVE FOR NEXT READ                   06100000
         SR    FMTREG,FMTREG       CLEAR FORMAT REG                     06150000
         LA    DSPTABRG,DSPTAB     ADDR OF DISPLAY TABLE                06200000
         IC    FMTREG,ZERO(DSPTABRG,RLNREG)  GET FORMAT ID              06250000
         B     FORMATBR(FMTREG)                                         06300000
FORMATBR EQU   *                                                        06350000
         B     FMT0                FORMAT 0 ON SCREEN                   06400000
         B     FMT1                FORMAT 1 ON SCREEN                   06450000
         B     FMT2                FORMAT 2 ON SCREEN                   06500000
FMT0     EQU   *                                                        06550000
*   VERIFY THE NAME AND SOCIAL SECURITY NUMBER. ASSUMING THAT THEY      06600000
* ARE VALID, WE SHALL CONTINUE PROCESSING.                              06650000
FMT01    EQU   *                                                        06700000
         LA    FMTREG,FOUR         GET FORMAT 1 ID                      06750000
         STC   FMTREG,ZERO(DSPTABRG,RLNREG)  STORE IN DISPLAY TABLE     06800000
         LA    MSGADDR,FORMAT1     ADDR OF FORMAT1 MESSAGE              06850000
         LA    MSGLEN,FMT1SZ       LENGTH OF MESSAGE                    06900000
         BAL   LNKREG,WRITETS      GO WRITE FORMAT 1                    06950000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    07000000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  07050000
         B     READ                GO READ ANOTHER DISPLAY              07100000
FMT1     EQU   *                                                        07150000
         CLI   INAREA,ENTER        ENTER KEY INTERRUPT                  07200000
         BE    ENTERINT            YES, GO UPDATE RECORDS               07250000
         CLI   INAREA,PA1          PA1 KEY INTERRUPT                    07300000
         BE    PA1INT              YES, GO MAKE HARD COPY               07350000
         CLI   INAREA,PA2          PA2 OR CNCL KEY INTERRUPT            07400000
         BE    PA2INT              YES, GO DEACTIVATE TERMINAL          07450000
         CLI   INAREA,CLEAR        CLEAR KEY INTERRUPT                  07500000
         BE    CLEARINT            YES, GO WRITE FORMAT 2               07550000
         B     READ                IGNORE THE INTERRUPT AND GO READ     07600000
ENTERINT EQU   *                                                        07650000
*   CREATE A NEW OR UPDATE AN EXISTING ENTRY IN YOUR PERMANENT          07700000
* DATA SET.                                                             07750000
ENTERIN1 EQU   *                                                        07800000
         BAL   LNKREG,WRITETUS     GO ERASE ALL UNPROTECTED DATA        07850000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    07900000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  07950000
         B     READ                GO READ ANOTHER DISPLAY              08000000
PA1INT   EQU   *                                                        08050000
         TM    FLAGS,PRINTER       IS A PRINTER DEFINED                 08100000
         BNO   NOPRINT             NO, CANNOT HONOR PRINT REQUEST       08150000
         L     PTRTAB,CURRPTR      ADDR PRINTER RLN TABLE               08200000
         CLI   ZERO(PTRTAB),HEXFF  CHECK FOR END OF TABLE               08250000
         BNE   PA1INT1             NO, GO READ BUFFER                   08300000
         LA    PTRTAB,PTRRLNTB     ADDR BEGINNING OF PTR TABLE          08350000
         ST    PTRTAB,CURRPTR      SAVE CURRENT PTR TABLE ENTRY         08400000
PA1INT1  EQU   *                                                        08450000
         BAL   LNKREG,READTB       GO READ ENTINE BUFFER                08500000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    08550000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  08600000
         IC    RLNREG,ZERO(PTRTAB) GET RLN OF PRINTER                   08650000
         MVI   INAREA+TWO,PRNTWCC  GET WCC WITH START PRINT BIT ON      08700000
         LA    MSGADDR,INAREA+TWO  ADDR OF PRINTER OUTPUT MSG           08750000
         LH    WORKREG,DECBD+EIGTEEN GET RESIDUAL COUNT                 08800000
         L     MSGLEN,TWOTHO       GET ORIGINAL COUNT                   08850000
         SR    MSGLEN,WORKREG      GET NUMBER OF BYTES READ             08900000
         S     MSGLEN,TWO2         DECREASE LENGTH BY TWO               08950000
         BAL   LNKREG,WRITETS      GO WRITE TO PRINTER                  09000000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    09050000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  09100000
         LA    PTRTAB,ONE(PTRTAB)  POINT TO NEXT PRINTER ENTRY          09150000
         ST    PTRTAB,CURRPTR      SAVE IT FOR NEXT TIME                09200000
         IC    RLNREG,RLNREAD      GET RLN THAT REQUESTED PRINT         09250000
         B     ENTERIN1            GO ERASE UNPROTECTED DATA            09300000
PA2INT   EQU   *                                                        09350000
*   DETERMINE IF ANY DATA WAS ENTERED. IF SO, CREATE A NEW OR UPDATE    09400000
* AN EXISTING ENTRY IN YOUR PERMANENT DATA SET. NOW DEACTIVATE THE      09450000
* TERMINAL.                                                             09500000
PA2INT1  EQU   *                                                        09550000
         CHGNTRY DTFBTL,ATTLST,(RLNREG),SKIP                            09600000
         LA    MSGADDR,CLOSEMG     ADDR OF CLOSE MSG                    09650000
         LA    MSGLEN,CLOSEMGL     LENGTH OF MSG                        09700000
         BAL   LNKREG,WRITETS      GO WRITE ENDING MSG                  09750000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    09800000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  09850000
         LA    FMTREG,HEXFF        GET DEACTIVATED TERMINAL ID          09900000
         STC   FMTREG,ZERO(DSPTABRG,RLNREG)  STORE IN DISPLAY TABLE     09950000
         B     READ                GO READ ANOTHER DISPLAY              10000000
CLEARINT EQU   *                                                        10050000
         LA    MSGADDR,FORMAT2     ADDR OF FORMAT 2 MSG                 10100000
         LA    MSGLEN,FMT2SZ       LENGTH OF MSG                        10150000
         BAL   LNKREG,WRITETS      GO WRITE FORMAT 2                    10200000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    10250000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  10300000
         LA    FMTREG,EIGHT        GET FORMAT 2 ID                      10350000
         STC   FMTREG,ZERO(DSPTABRG,RLNREG)  STORE IN DISPLAY TABLE     10400000
         B     READ                GO READ ANOTHER DISPLAY              10450000
FMT2     EQU   *                                                        10500000
         CLI   INAREA,ENTER        ENTER KEY INTERRUPT                  10550000
         BE    FMT01               YES, GO WRITE FORMAT 1               10600000
         CLI   INAREA,PA1          PA1 KEY INTERRUPT                    10650000
         BE    PA1INT              YES, GO MAKE HARD COPY               10700000
         CLI   INAREA,PA2          PA2 OR CNCL KEY INTERRUPT            10750000
         BE    PA2INT1             YES, GO DEACTIVATE TERMINAL          10800000
         CLI   INAREA,CLEAR        CLEAR KEY INTERRUPT                  10850000
         BE    CLEARINT            GO WRITE FORMAT 2                    10900000
         B     READ                GO READ ANOTHER DISPLAY              10950000
NOPRINT  EQU   *                                                        11000000
         LA    MSGADDR,NOPTR       ADDR OF NO PRINTER MSG               11050000
         LA    MSGLEN,NOPTRL       LENGTH OF MSG                        11100000
         BAL   LNKREG,WRITETI      GO WRITE MSG                         11150000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    11200000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  11250000
         B     READ                GO READ ANOTHER DISPLAY              11300000
         EJECT                                                          11350000
RETCODE  EQU   *                                                        11400000
         B     RTNCDTAB(RTNCDRG)   BRANCH TO CORRESPONDING ENYRY        11450000
RTNCDTAB EQU   *                                                        11500000
         B     RTNCD0              I/O SUCCESSFULLY INITIATED           11550000
         B     RTNCD4              DTFBT BUSY                           11600000
         B     RTNCD8              INVALID RLN                          11650000
         B     RTNCDC              INVALID TYPE CODE                    11700000
         B     RTNCD10             ALL SKIP BITS ON                     11750000
         B     RTNCD14             LINE ERROR AT OPEN                   11800000
         B     RTNCD18             NO BUFFERS                           11850000
         B     RTNCD1C             NO BUFFER POOL                       11900000
         B     RTNCD20             NO BUFFER MANAGEMENT                 11950000
         B     RTNCD24             BSC USAGE COUNT EXCEEDED             12000000
         B     RTNCD28             3270 LOCAL PRINTER BUSY              12050000
         B     RTNCD2C             3270 NO SBA ORDER IN READ FROM POS   12100000
         B     RTNCD30             DEVICE BUFFER UNRELIABLE             12150000
         B     RTNCD34             OLTEP HAS THE LOCAL 3270             12200000
         BC    0,*                 NOP                         @DM16465 12210000
         BC    0,*                 NOP                         @DM16465 12213000
         B     RTNCD40             DEVICE ASSGINED TO IGNORE   @DM16465 12223000
RTNCD0   EQU   *                                                        12250000
         BR    LNKREG              RETURN                               12300000
RTNCD4   EQU   *                                                        12350000
         S     LNKREG,EIGHT8       SUBTRACT 8 FROM RETURN ADDR          12400000
         BR    LNKREG                 TO RETRY THE OPERATION            12450000
RTNCD8   EQU   *                                                        12500000
         STH   RLNREG,MAXRLN       SAVE MAXIMUM + 1 RLN                 12550000
         SR    RLNREG,RLNREG       CLEAR RLN TO 0                       12600000
         B     READ                GO READ                              12650000
RTNCDC   EQU   *                                                        12700000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      12750000
RTNCD10  EQU   *                                                        12800000
         B     CLOSE               ALL TERMINALS, TERMINATE             12850000
RTNCD14  EQU   *                                                        12900000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      12950000
RTNCD18  EQU   *                                                        13000000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13050000
RTNCD1C  EQU   *                                                        13100000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13150000
RTNCD20  EQU   *                                                        13200000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13250000
RTNCD24  EQU   *                                                        13300000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13350000
RTNCD28  EQU   *                                                        13400000
         S     LNKREG,EIGHT8       SUBTRACT 8 FROM RETURN ADDR          13450000
         BR    LNKREG                 TO RETRY THE OPERATION            13500000
RTNCD2C  EQU   *                                                        13550000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13600000
*                             SINCE NO READS FROM POSITIONS ARE USED    13650000
RTNCD30  EQU   *                                                        13700000
         S     LNKREG,EIGHT8       SUBTRACT 8 FROM RETURN ADDR          13750000
         BR    LNKREG              TO RETRY THE OPERATION               13800000
RTNCD34  EQU   *                                                        13850000
         B     READ                                                     13900000
         EJECT                                                          13950000
WAITD    EQU   *                                                        14000000
         WAIT  ECB=DECBD                                                14050000
         SPACE 5                                                        14100000
CHK7FCC  EQU   *                                                        14150000
         CLI   DECBD,SEVENF        NORMAL COMPLETION CODE               14200000
         BNE   CHK64CC             NO CHECK OTHERS                      14250000
         BR    LNKREG              RETURN                               14300000
CHK64CC  EQU   *                                                        14350000
         CLI   DECBD,SIXTY4        DEVICE BUFFER CLOBBERED FROM RFT     14400000
         BNE   CHK42CC             NO, CHECK SOME MORE                  14450000
         SR    FMTREG,FMTREG       CLEAR FORMAT REG            @DA10723 14470000
         IC    RLNREG,DECBD+THRTY9 GET RLN OF CLOBBERED DEVICE          14500000
         IC    FMTREG,0(RLNREG,DSPTABRG) GET FORMAT ID                  14550000
         B     WTFMTX(FMTREG)                                           14600000
WTFMTX   EQU   *                                                        14650000
         B     WTFMT0              RE-INITIALIZE FORMAT 0               14700000
         B     WTFMT1              RE-INITIALIZE FORMAT 1               14750000
         B     WTFMT2              RE-INITIALIZE FORMAT 2               14800000
         B     ABNORMAL            DUMP, SHOULD BE INACTIVE             14850000
WTFMT0   EQU   *                                                        14900000
         LA    MSGADDR,FORMAT0     ADDR OF OUTPUT MESSAGE               14950000
         LA    MSGLEN,FMT0SZ       LENGTH OF MESSAGE                    15000000
WTDVUNRL EQU   *                                                        15050000
         WRITE DECBD,TS,DTFBTL,(MSGADDR),(MSGLEN),,(RLNREG),MF=E        15100000
         BNZ   ABNORMAL            DUMP, ABNORMAL RETURN CODE           15150000
         WAIT  ECB=DECBD                                                15200000
         B     CHK7FCC             CHECK COMPLETION CODE                15250000
WTFMT1   EQU   *                                                        15300000
         LA    MSGADDR,FORMAT1     ADDR OF FORMAT 1 MSG                 15350000
         LA    MSGLEN,FMT1SZ       LENGTH OF MSG                        15400000
         B     WTDVUNRL            GO RESTORE SCREEN                    15450000
WTFMT2   EQU   *                                                        15500000
         LA    MSGADDR,FORMAT2     ADDR OF FORMAT 2 MSG                 15550000
         LA    MSGLEN,FMT2SZ       LENGTH OF MSG                        15600000
         B     WTDVUNRL            GO RESTORE SCREEN                    15650000
CHK42CC  EQU   *                                                        15700000
         CLI   DECBD,FOURTY2       RFT RECEIVED COMP CODE               15750000
         BNE   ABNORMAL                                                 15800000
         TWAIT (REG2),TERMTST,ECBLIST=DECBADDR                          15850000
         B     CHK7FCC             CHECK COMPLETION CODE                15900000
         SPACE 5                                                        15950000
CLOSE    EQU   *                                                        16000000
         BTRD  DTFBTL                                                   16050000
         CLOSE DTFBTL                                                   16100000
         EOJ                                                            16150000
         SPACE 5                                                        16200000
RTNCD40  EQU   *                   DEVICE ASSIGNED TO IGNORE   @DM16465 16220000
ABNORMAL EQU   *                                                        16250000
         STM   REGZERO,REG15,REGSAVE    SAVE REGS                       16300000
*        ONE LINE DELETED BY APAR DA10722                      @DA10722 16350000
         L     WORKREG,=A(IJLBTEND)    GET ENDING ADDRESS      @DA10722 16400000
         PDUMP BASE,(WORKREG)                                  @DA10722 16450000
         EOJ                                                            16500000
         EJECT                                                          16550000
H4096    DC    H'4096'                                                  16600000
FORMAT0  EQU   *                                                        16650000
         DC    X'C71140401DE8'     WCC, SBA = 0, SF = PROT,INT @DA10721 16700000
         DC    X'11C150'           SBA = 80                    @DA10721 16720000
         DC    C'GOOD MORNING.'                                         16750000
         DC    X'1D6011C15F'       SF = PROT, SBA = 94                  16800000
         DC    C'THIS BEGINS THE DEMONSTRATION '                        16850000
         DC    C'OF THE DOS/BTAM '                                      16900000
         DC    X'1DE8'             SF = PROT,INT               @DA10721 16950000
         DC    C'3270 '                                                 17000000
         DC    X'1D60'             SF = PROT                            17050000
         DC    C'LOCAL SAMPLE PROGRAM.'                                 17100000
         DC    X'1D6011C3F0'       SF = PROT, SBA = 240                 17150000
         DC    C'ENTER THE FOLLOWING:'                                  17200000
         DC    X'1D6011C4D8'       SF = PROT, SBA = 280                 17250000
         DC    C'NAME:'                                                 17300000
         DC    X'1D4013'           SF = UNPROT, IC                      17350000
         DC    X'11C5401D60'       SBA = 320,SF = PROT                  17400000
         DC    C'SOC SEC NUM:'                                          17450000
         DC    X'1D40'             SF = UNPROT                          17500000
         DC    X'11C5E81D60'       SBA = 360, SF = PROT        @DA10721 17550000
FMT0SZ   EQU   *-FORMAT0                                                17600000
         SPACE 5                                                        17650000
FORMAT1  EQU   *                                                        17700000
         DC    X'C71140401D60'     WCC, SBA = 0, SF = PROT     @DA10721 17750000
         DC    X'1140C1'           SBA = 1                     @DA10721 17770000
         DC    C'ENTER DATA REQUESTED BELOW:'                           17800000
         DC    X'11C150'           SBA = 80                             17850000
         DC    C'NAME:'                                                 17900000
         DC    X'1D4013'           SF = UNPROT, IC             @DA10721 17950000
         DC    X'11C1F81D60'       SBA = 120, SF = PROT        @DA10721 18000000
         DC    C'ADDR:'                                                 18050000
         DC    X'1D40'             SF = UNPROT                 @DA10721 18100000
         DC    X'11C2601D60'       SBA = 160, SF = PROT        @DA10721 18120000
         DC    C'CITY:'                                                 18150000
         DC    X'1D40'             SF = UNPROT                 @DA10721 18200000
         DC    X'11C3C81D60'       SBA = 200, SF = PROT        @DA10721 18220000
         DC    C'STATE:'                                                18250000
         DC    X'1D40'             SF = UNPROT                 @DA10721 18300000
         DC    X'11C3E41D60'       SBA = 228, SF = PROT        @DA10721 18320000
         DC    C'ZIP:'                                                  18350000
         DC    X'1D50'             SF = UNPROT,NUM             @DA10721 18400000
         DC    X'11C3F01D60'       SBA = 240, SF = PROT        @DA10721 18420000
         DC    X'11C4D8'           SBA = 280                   @DA10721 18450000
         DC    C'ENTER KEY: ENTER DATA;'                                18500000
         DC    X'11C540'           SBA = 320                            18550000
         DC    C'PA1 KEY: PRINT DATA;'                                  18600000
         DC    X'11C5E8'           SBA = 360                            18650000
         DC    C'PA2 (CNCL) KEY: DEACTIVATE TERMINAL;'                  18700000
         DC    X'11C650'           SBA = 400                            18750000
         DC    C'CLEAR KEY: CONTROL OPTIONS;'                           18800000
FMT1SZ   EQU   *-FORMAT1                                                18850000
         SPACE 5                                                        18900000
FORMAT2  EQU   *                                                        18950000
         DC    X'C711404013'       WCC, SBA = 0, IC                     19000000
         DC    C'XXYY3CUU'                                              19050000
         DC    X'1140E8'           SBA = 40                             19100000
         DC    C'TO REQUEST BTAM OLT -- ENTER REQUEST FOR TEST MESS'    19150000
         DC    C'AGE OVER SAMPLE FORMAT ABOVE:  XX=TEST NO. (23-28)'    19200000
         DC    C'  YY=REPEATS (01-99)  CUU=ADDRESS OF TARGET DEVICE'    19250000
         DC    X'11C3C8'           SBA = 200                            19300000
         DC    C'THEN HIT ERASE EOF AND THEN TEST REQ. USE CLEAR KE'    19350000
         DC    C'Y TO RESUME AFTER TEST.'                               19400000
FMT2SZ   EQU   *-FORMAT2                                                19450000
         SPACE 5                                                        19500000
NOPTR    EQU   *                                                        19550000
         DC    X'C611C6F71DE8'   WCC, SBA = 339, SF = PROT,INT @DA10721 19600000
         DC    C'NO PRINTER DEFINED FOR THIS PROGRAM'                   19650000
NOPTRL   EQU   *-NOPTR                                                  19700000
         SPACE 5                                                        19750000
CLOSEMG  EQU   *                                                        19800000
         DC    X'C71140401DE8'     WCC, SBA = 0, SF = PROT,INT @DA10721 19850000
         DC    C'THIS TERMINAL IS NOW INACTIVE. WHEN ALL REMAINING '    19900000
         DC    C'TERMINALS BECOME INACTIVE, THE LOCAL 3270 SAMPLE '     19950000
         DC    C'PROGRAM WILL BE OVER.'                                 20000000
CLOSEMGL EQU   *-CLOSEMG                                                20050000
         EJECT                                                          20100000
*        READ AND WRITE MACROS                                          20150000
         DS    0F                                                       20200000
WRITETS  EQU   *                                                        20250000
         WRITE DECBD,TS,DTFBTL,(MSGADDR),(MSGLEN),,(RLNREG),MF=E        20300000
         BR    LNKREG              RETURN                               20350000
         SPACE 5                                                        20400000
READTI   EQU   *                                                        20450000
         READ  DECBD,TI,DTFBTL,INAREA,300,,(RLNREG),MF=E                20500000
         BR    LNKREG              RETURN                               20550000
         EJECT                                                          20600000
READTB   EQU   *                                                        20650000
         READ  DECBD,TB,DTFBTL,INAREA,2000,,(RLNREG),MF=E               20700000
         BR    LNKREG              RETURN                               20750000
         SPACE 5                                                        20800000
WRITETI  EQU   *                                                        20850000
         WRITE DECBD,TI,DTFBTL,(MSGADDR),(MSGLEN),,(RLNREG),MF=E        20900000
         BR    LNKREG                                                   20950000
         EJECT                                                          21000000
WRITETUS EQU   *                                                        21050000
         WRITE DECBD,TUS,DTFBTL,FLAGS,1,,(RLNREG),MF=E                  21100000
         BR    LNKREG                                                   21150000
         SPACE 5                                                        21200000
*        CONSTANTS                                                      21250000
REGSAVE  DC    16F'0'              REGISTER SAVE AREA                   21300000
CURRPTR  DC    F'0'                POINTER TO CURRENT PTR RLN           21350000
TWO2     DC    F'2'                CONSTANT OF TWO                      21400000
EIGHT8   DC    F'8'                CONSTANT OF 8                        21450000
TWOTHO   DC    F'2000'                                                  21500000
INAREA   DC    500F'0'             INPUT AREA                           21550000
DECBADDR DC    X'80'                                                    21600000
         DC    AL3(DECBD)                                               21650000
VDTF     DC    V(DTFBTL)                                                21700000
         DS    0F                                                       21750000
*        ONE LINE DELETED BY APAR DA10722                      @DA10722 21800000
DSPTAB   DC    XL32'0'             DISPLAY TABLE                        21850000
RLNREAD  DC    X'00'               RLN OF DEVICE JUST READ              21900000
FLAGS    DC    X'00'               BYTE OF FLAGS                        21950000
PTRRLNTB DC    X'FFFFFFFFFFFFFFFF' PRINTER RLN TABLE                    22000000
         DC    X'FFFFFFFFFFFFFFFF'                                      22050000
         DC    X'FFFFFFFFFFFFFFFF'                                      22100000
         DC    X'FFFFFFFFFFFFFFFF'                                      22150000
MAXRLN   DC    H'0'                MAXIMUM RLN SAVE                     22200000
         EJECT                                                          22250000
* THE FIRST OPERAND IN THE RMSRTAB MACRO MUST BE CHANGED TO REFLECT     22300000
* THE NUMBER OF 3270'S IN YOUR SYSTEM. PRESENTLY THE 2 REFLECTS THE     22350000
* LINELST OPERAND ON THE DTFBT MACRO.                                   22400000
RMSRTAB  RMSRTAB 2,,                                           @DA10721 22450000
         SPACE 5                                                        22500000
* THE LINELST OPERAND SHOULD BE MODIFIED TO REFLECT THE NUMBER OF       22550000
* 3270 DISPLAYS AND PRINTERS IN YOUR SYSTEM. THE PRESENT LINELST        22600000
* OPERAND MEANS THAT THIS SAMPLE PROGRAM WILL USE TWO 3270'S.           22650000
DTFBTL   DTFBT LINELST=(005,006),                                      X22700000
               CU=3272,DEVICE=3277,TERMTST=YES,MODNAME=L3270MOD,       X22750000
               LERBADR=RMSRTAB                                 @DA10721 22800000
         SPACE 5                                                        22850000
         READ  DECBD,TI,DTFBTL,MF=L                                     22900000
         LTORG                                                          22950000
         EJECT                                                          23000000
L3270MOD BTMOD L3277=YES,TST3277=YES,RMSR=YES                       4-0 23050000
         END                                                            23100000
        BKEND
        CATALS   Z.SAMP327R,34.0
        BKEND   Z.SAMP327R
         PUNCH ' PHASE SAMP327R,* '                                     00050000
SAMP327R CSECT                                                          00100000
         SPACE 5                                                        00150000
*        THIS IS A SAMPLE PROGRAM FOR A REMOTE 3270 INFORMATION DISPLAY 00200000
*  SYSTEM.  PLEASE NOTE THAT THIS PROGRAM HAS BEEN WRITTEN FOR TWO      00250000
*  3270 DEVICES, BOTH OF WHICH MUST BE 3277 DISPLAYS.                   00300000
*                                                                       00350000
*        TO ASSEMBLE THIS SAMPLE PROBLEM, FIRST REMOVE ALL CATALS AND   00400000
*  BKEND CARDS, AND THEN PUNCH AND INSERT THE NECESSARY JOB CONTROL     00450000
*  CARDS FOR AN ASSEMBLY.                                               00500000
*                                                                       00550000
*        NOW THE OUTPUT FROM THE ASSEMBLER (THE OBJECT DECK) MUST BE    00600000
*  LINKAGE-EDITED TO THE CORE IMAGE LIBRARY IN THE DESIRED PARTITION.   00650000
*                                                                       00670000
*        THE FOLLOWING I/O ASSIGNMENT  MUST BE MADE TO ASSOCIATE THE    00690000
*  3270 DEVICES WITH THE PROGRAM:                                       00730000
*                            // ASSGN SYS005,X'CUU'                     00770000
*                                                                       00850000
*        TO EXECUTE THIS SAMPLE PROGRAM, ENTER FROM THE OPERATORS       00870000
*  CONSOLE OR THROUGH THE CARD READER THE FOLLOWING:                    00890000
*                           // EXEC SAMP327R                            00930000
*                                                                       00970000
*        IT MAY BE NECESSARY TO ALTER THIS SAMPLE PROBLEM SO THAT IT    01050000
*  MAY FUNCTION WITH MORE THAN TWO DEVICES.  TO DO SO, THE FOLLOWING    01070000
*  CARDS MUST BE CHANGED IN THE SOURCE DECK:                            01090000
*                           1. DFTRMLST MACROS  (SELDSPLY)              01130000
*                                               (SPECPOL)               01170000
*                                                                       01250000
*        THIS SAMPLE PROGRAM IS RESTRICTED TO A MAXIMIM OF 32 DEVICES,  01270000
*  ALL OF WHICH MUST BE ATTACHED TO ONE REMOTE 3271 CONTROL UNIT.       01290000
*                                                                       01330000
***************************  APARS FIXED  ***************************** 01370000
*                                                                     * 01450000
*   DA10720, DA10721, DA10722, DA20122                                * 01470000
*                                                                     * 01490000
*********************************************************************** 01530000
         EJECT                                                          01570000
*        REGISTER EQUATES                                               01650000
REGZERO  EQU   0                   REGISTER 0                           01670000
REG2     EQU   2                   WORK REGISTER                        01690000
WORKREG  EQU   3                   WORK REGISTER                        01730000
MSGADDR  EQU   4                   ADDR OF OUTPUT MESSAGE               01770000
MSGLEN   EQU   5                   LENGTH OF OUTPUT MESSAGE             01850000
SELREG   EQU   6              SPEC POLL ADDR OF 3270 DISPLAY            01870000
FMTREG   EQU   8                   FORMAT IDENTIFIER                    01890000
DSPTABRG EQU   9                   ADDRESS OF DISPLAY TABLE             01930000
LNKREG   EQU   10                  LINKAGE REGISTER                     01970000
BASEREG  EQU   11                  FIRST BASE REG                       02050000
BASEREG2 EQU   12                  SENOND BASE REG                      02070000
PTRTAB   EQU   13                  PRINTER RLN TABLE ADDRESS            02090000
RTNCDRG  EQU   15                  RETURN CODE REGISTER                 02130000
REG15    EQU   15                  REGISTER 15                          02170000
         SPACE 5                                                        02250000
*        EQUATES                                                        02270000
ZERO     EQU   0                   LENGTH OF 0                          02290000
ONE      EQU   1                   LENGTH OF 1                          02330000
TWO      EQU   2                   LENGTH OF 2                          02370000
THREE    EQU   3                   LENGTH OF 3                          02450000
FOUR     EQU   4                   FORMAT 1 IDENTIFIER                  02470000
FIVE     EQU   5              LENGTH OF TERMINAL LIST ENTRIES           02490000
SIX      EQU   6                   LENGTH OF 6                          02530000
TP06     EQU   6                   TP CODE OF 6                         02570000
SEVEN    EQU   7                   LENGTH OF 7                          02650000
EIGHT    EQU   8                   FORMAT 2 IDENTIFIER                  02670000
TP11     EQU   X'11'               TP CODE OF 11                        02690000
SIXTN    EQU   16                  LENGTH IF 16                         02730000
TP20     EQU   X'20'                                                    02770000
TWENTY4  EQU   24             LENGTH OF 24                              02850000
TWENTY8  EQU   28                  LENGTH OF 28                         02870000
FIFTY4   EQU   54                  NON OPERATION COMP CODE              02890000
TWO55    EQU   255            LENGTH OF 255                             02930000
TIMEOUT  EQU   X'01'               DECB TIME OUT FLAG                   02970000
RVIRSP   EQU   X'02'               RVI RESPONSE TO ADDR FLAG            03050000
SSMSG    EQU   X'10'               SENSE/STATUS RECEIVED FLAG           03070000
EOTRSPTX EQU   X'40'               EOT RESPONSE TO TEXT                 03090000
EOTRCVD  EQU   X'40'               EOT RECEIVED FLAG                    03130000
FOURTY1  EQU   X'41'               I/O ERROR COMP CODE                  03170000
FOURTY2  EQU   X'42'               RFT RECEIVED COMP CODE               03250000
SIXTY1   EQU   X'61'               RVI RESPONSE TO ADDR COMP CODE       03270000
PA1      EQU   X'6C'               ATTENTION ID FOR PA1 KEY             03290000
CLEAR    EQU   X'6D'               ATTENTION ID FOR CLEAR KEY           03330000
PA2      EQU   X'6E'               ATTENTION ID FOR PA2 (CNCL) KEY      03370000
ENTER    EQU   X'7D'               ATTENTION ID FOR ENTER KEY           03450000
SEVENF   EQU   X'7F'               NORMAL COMPLETION CODE               03470000
LAST     EQU   X'80'          SIGNIFIES END OF POLLING LIST             03490000
TWO53    EQU   X'FD'                                                    03530000
         EJECT                                                          03570000
BASE     BALR  BASEREG,0           ESTABLISH                   @DA10722 03650000
         USING *,BASEREG,BASEREG2            ADDRESSABILITY             03670000
         LR    BASEREG2,BASEREG    INITIALIZE                           03690000
         AH    BASEREG2,H4096                 SECOND BASE               03730000
*        OPEN THE LINE GROUP                                            03770000
         OPEN  DTFBTR                                                   03850000
         LA    DSPTABRG,DSPTAB     ADDRESS THE DISPLAY TABLE            03870000
         LA    SELREG,SELDSPLY     GET SELECTION ADDRESS OF             03890000
*                                       FIRST 3270 DISPLAY              03930000
         SPACE 5                                                        03970000
INITIAL   EQU  *                                                        04050000
         LA    MSGADDR,FORMAT0     ADDR OF FORMAT0 MESSAGE              04070000
         LA    MSGLEN,FMT0SZ       LENGTH OF MESSAGE                    04090000
         BAL   LNKREG,WRITETI      GO WRITE FORMAT 0                    04130000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    04170000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  04250000
         LA    SELREG,FIVE(SELREG) ADDR NEXT SPECIFIC POLL ENTRY        04270000
         TM    ZERO(SELREG),LAST   END OF SELECTION LIST                04290000
         BO    READ                YES, GO ISSUE A READ                 04330000
         LA    SELREG,ONE(SELREG)  ADDR OF NEXT ENTRY                   04370000
         B     INITIAL             NO, WRITE TO REMAINING DISPLAYS      04450000
         SPACE 5                                                        04470000
READ     EQU   *                                                        04490000
         LA    MSGADDR,INAREA      ADDR OF INPUT AREA                   04530000
         XC    INAREA(256),INAREA    CLEAR INPUT               @DA10721 04570000
         XC    INAREA+256(44),INAREA             AREA          @DA10721 04650000
         BAL   LNKREG,READTI       GO READ A DISPLAY                    04670000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    04690000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  04730000
         MVC   CUDVSAVE(TWO),INAREA+TWO SAVE CU,DV                      04770000
         TM    DECBD+EIGHT,SSMSG   SENSE/STATUS MESSAGE RECEIVED        04850000
         BO    SSCHECK                                                  04870000
         LA    SELREG,SPECPOL      ADDR OD SPEC POLL TABLE              04890000
         SR    REG2,REG2           CLEAR REGISTER 2                     04930000
CHKIT    EQU   *                                                        04970000
         CLC    ONE(TWO,SELREG),INAREA+TWO CHECK FOR CU,DV              05050000
         BE    FNDSEL              YES, GET SELECTION ADDR              05070000
         LA    REG2,ONE(REG2)      ADD ONE TO INDEX                     05090000
         LA    SELREG,FIVE(SELREG)  POINT TO NEXT ENTRY        @DA20122 05130000
         TM    ZERO(SELREG),LAST   END OF LIST                          05170000
         BO    ABNORMAL                                                 05250000
         LA    SELREG,ONE(SELREG)                                       05260000
         B     CHKIT               NO KEEP CHECKING                     05270000
FNDSEL   EQU   *                                                        05290000
         STC   REG2,INDEX          SAVE INDEX BYTE                      05330000
         LR    WORKREG,REG2        GET INDEX INTO ODD REGISTER          05370000
         M     REG2,SIXL           MULTIPLY INDEX BY 6                  05450000
         LR    REG2,WORKREG        RE-ESTABLISH INDEX REG               05470000
         LA    SELREG,SELDSPLY     GET SELECTION ADDRES                 05490000
         AR    SELREG,REG2         ADDR OUTPUT ENTRY IN TABLE           05530000
         ST    SELREG,SELSAVE      SAVE SELECTION ADDR                  05570000
         SR    FMTREG,FMTREG       CLEAR FORMAT REG                     05650000
         LA    DSPTABRG,DSPTAB     ADDR OF DISPLAY TABLE                05660000
         IC    REG2,INDEX                                               05670000
         IC     FMTREG,ZERO(DSPTABRG,REG2) GET FORMAT ID       @DA20122 05690000
         B     FORMATBR(FMTREG)                                         05730000
         SPACE 5                                                        07100000
FORMATBR EQU   *                                                        07150000
         B     FMT0                FORMAT 0 ON SCREEN                   07170000
         B     FMT1                FORMAT 1 ON SCREEN                   07190000
         B     FMT2                FORMAT 2 ON SCREEN                   07230000
         SPACE 5                                                        07270000
FMT0     EQU   *                                                        07350000
*   VERIFY THE NAME AND SOCIAL SECURITY NUMBER. ASSUMING THAT THEY      07370000
* ARE VALID, WE SHALL CONTINUE PROCESSING.                              07390000
FMT01    EQU   *                                                        07430000
         LA    FMTREG,FOUR         GET FORMAT 1 ID                      07470000
         STC    FMTREG,ZERO(DSPTABRG,REG2) STORE IN DISPLAY TABLE       07550000
         LA    MSGADDR,FORMAT1     ADDR OF FORMAT1 MESSAGE              07570000
         LA    MSGLEN,FMT1SZ       LENGTH OF MESSAGE                    07590000
         BAL    LNKREG,WRITETI     GO WRITE FORMAT 1                    07630000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    07670000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  07750000
         B     READ                GO READ ANOTHER DISPLAY              07770000
         SPACE 5                                                        07790000
FMT1     EQU   *                                                        07830000
         CLI   INAREA+FOUR,ENTER   ENTER KEY INTERRUPT                  07870000
         BE    ENTERINT            YES, GO UPDATE RECORDS               07950000
         CLI   INAREA+FOUR,PA1     PA1 KEY INTERRUPT                    07970000
         BE    PA1INT              YES, GO MAKE HARD COPY               07990000
         CLI   INAREA+FOUR,PA2     PA2 OR CNCL KEY INTERRUPT            08030000
         BE    PA2INT              YES, GO DEACTIVATE TERMINAL          08070000
         CLI   INAREA+FOUR,CLEAR   CLEAR KEY INTERRUPT                  08150000
         BE    CLEARINT            YES, GO WRITE FORMAT 2               08170000
         B     READ                IGNORE THE INTERRUPT AND GO READ     08190000
         SPACE 5                                                        08230000
ENTERINT EQU   *                                                        08270000
*   CREATE A NEW OR UPDATE AN EXISTING ENTRY IN YOUR PERMANENT          08350000
* DATA SET.                                                             08370000
ENTERIN1 EQU   *                                                        08390000
         LA    MSGADDR,ERALUNP     ADDR OF MESSAGE                      08430000
         LA    MSGLEN,ERALUNPL     LENGTH OF MESSAGE                    08470000
         BAL   LNKREG,WRITETI      GO ERASE ALL UNPROTECTED DATA        08550000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    08570000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  08590000
         B     READ                GO READ ANOTHER DISPLAY              08630000
PA1INT   EQU   *                                                        08670000
         B     NOPRINT             NO PRINTER DEFINED                   08750000
PA2INT   EQU   *                                                        08770000
*   DETERMINE IF ANY DATA WAS ENTERED. IF SO, CREATE A NEW OR UPDATE    08790000
* AN EXISTING ENTRY IN YOUR PERMANENT DATA SET. NOW DEACTIVATE THE      08830000
* TERMINAL.                                                             08870000
PA2INT1  EQU   *                                                        08950000
         LA    MSGADDR,CLOSEMG     ADDR OF CLOSE MSG                    08970000
         LA    MSGLEN,CLOSEMGL     LENGTH OF MSG                        08990000
         LA    SELREG,SELDSPLY     ADDR OF SELECTION TABLE              09030000
ONCEMORE EQU   *                                                        09070000
         BAL   LNKREG,WRITETI      GO WRITE ENDING MSG                  09150000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    09170000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  09190000
         LA    SELREG,FIVE(SELREG) POINT TO INDICATOR BYTE              09230000
         TM    ZERO(SELREG),LAST   END OF SELECTION LIST                09270000
         BO    CLOSE               YES, TERMINATE PROGRAM               09350000
         LA    SELREG,ONE(SELREG)  POINT TO NEXT ADDRESS                09370000
         B     ONCEMORE            NO, WRITE ANOTHER MESSAGE            09390000
CLEARINT EQU   *                                                        09430000
         LA    MSGADDR,FORMAT2     ADDR OF FORMAT 2 MSG                 09470000
         LA    MSGLEN,FMT2SZ       LENGTH OF MSG                        09550000
         BAL   LNKREG,WRITETI      GO WRITE FORMAT 2                    09570000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    09590000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  09630000
         LA    FMTREG,EIGHT        GET FORMAT 2 ID                      09670000
         STC   FMTREG,ZERO(DSPTABRG,REG2) STORE IN DISPLAY TABLE        09750000
         B     READ                GO READ ANOTHER DISPLAY              09770000
FMT2     EQU   *                                                        09790000
         CLI   INAREA+FOUR,ENTER   ENTER KEY INTERRUPT                  09830000
         BE    FMT01               YES, GO WRITE FORMAT 1               09870000
         CLI   INAREA+FOUR,PA1     PA1 KEY INTERRUPT                    09950000
         BE    PA1INT              YES, GO MAKE HARD COPY               09970000
         CLI   INAREA+FOUR,PA2     PA2 OR CNCL KEY INTERRUPT            09990000
         BE    PA2INT1             YES, GO DEACTIVATE TERMINAL          10030000
         CLI   INAREA+FOUR,CLEAR   CLEAR KEY INTERRUPT                  10070000
         BE    CLEARINT            GO WRITE FORMAT 2                    10150000
         B     READ                GO READ ANOTHER DISPLAY              10170000
NOPRINT  EQU   *                                                        10190000
         LA    MSGADDR,NOPTR       ADDR OF NO PRINTER MSG               10230000
         LA    MSGLEN,NOPTRL       LENGTH OF MSG                        10270000
         BAL   LNKREG,WRITETI      GO WRITE MSG                         10350000
         BAL   LNKREG,RETCODE      CHECK RETURN CODE                    10370000
         BAL   LNKREG,WAITD        WAIT FOR COMPLETION                  10390000
         B     READ                GO READ ANOTHER DISPLAY              10430000
         EJECT                                                          10470000
RETCODE  EQU   *                                                        10550000
         B     RTNCDTAB(RTNCDRG)   BRANCH TO CORRESPONDING ENYRY        10570000
RTNCDTAB EQU   *                                                        10590000
         B     RTNCD0              I/O SUCCESSFULLY INITIATED           10630000
         B     RTNCD4              DTFBT BUSY                           10670000
         B     RTNCD8              INVALID RLN                          10750000
         B     RTNCDC              INVALID TYPE CODE                    10770000
         B     RTNCD10             ALL SKIP BITS ON                     10790000
         B     RTNCD14             LINE ERROR AT OPEN                   10830000
         B     RTNCD18             NO BUFFERS                           10870000
         B     RTNCD1C             NO BUFFER POOL                       10950000
         B     RTNCD20             NO BUFFER MANAGEMENT                 10970000
         B     RTNCD24             BSC USAGE COUNT EXCEEDED             10990000
         BC    0,*                 NOP                         @DA10720 11030000
         BC    0,*                 NOP                         @DA10720 11070000
         BC    0,*                 NOP                         @DA10720 11150000
         BC    0,*                 NOP                         @DA10720 11170000
         BC    0,*                 NOP                         @DA10720 11190000
         BC    0,*                 NOP                         @DA10720 11230000
         B     RTNCD40             DEVICE ASSIGNED TO IGNORE   @DA10720 11270000
RTNCD0   EQU   *                                                        11350000
         BR    LNKREG              RETURN                               11370000
RTNCD4   EQU   *                                                        11390000
         S     LNKREG,EIGHT8       SUBTRACT 8 FROM RETURN ADDR          11430000
         BR    LNKREG                 TO RETRY THE OPERATION            11470000
RTNCD8   EQU   *                                                        11550000
RTNCDC   EQU   *                                                        11570000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      12750000
RTNCD10  EQU   *                                                        12800000
         B     CLOSE               ALL TERMINALS, TERMINATE             12820000
RTNCD14  EQU   *                                                        12840000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      12880000
RTNCD18  EQU   *                                                        12920000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13000000
RTNCD1C  EQU   *                                                        13020000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13040000
RTNCD20  EQU   *                                                        13080000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13120000
RTNCD24  EQU   *                                                        13200000
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      13220000
         EJECT                                                          13240000
WAITD    EQU   *                                                        13280000
         WAIT  ECB=DECBD                                                13320000
CHK7FCC  EQU   *                                                        13400000
         CLI   DECBD,SEVENF        NORMAL COMPLETION CODE               13420000
         BNE   CHK42CC             NO, CHECK OTHERS                     13440000
         BR    LNKREG              RETURN                               13480000
CHK42CC  EQU   *                                                        13520000
         CLI   DECBD,FOURTY2       RFT RECEIVED COMP CODE               13600000
         BNE   CHK54CC             NO, CHECK OTHERS                     13620000
         TWAIT (REG2),TERMTST,ECBLIST=DECBADDR                          13640000
         B     CHK7FCC             CHECK COMPLETION CODE                13680000
CHK54CC  EQU   *                                                        13720000
         CLI   DECBD,FIFTY4        NON OPERATION COMP CODE              13800000
         BNE   CHK41CC             NO, KEEP CHECKING                    13820000
         B     READ                GO ISSUE READ                        13840000
CHK41CC  EQU   *                                                        13880000
         CLI   DECBD,FOURTY1       I/O ERROR COMP CODE                  13920000
         BNE   CHK61CC             NO, KEEP CHECKING                    14000000
         CLI   DECBD+TWENTY8,TP06  TP CODE OF 6                         14020000
         BNE   CKTP20              NO, CHECK OTHER TP CODES             14040000
         TM    DECBD+SIXTN,TIMEOUT DID DEVICE TIME OUT                  14080000
         BNO   ABNORMAL            NO, TERMINATE                        14120000
         S     LNKREG,TWELVE       SUBTRACR 12 FROM RETURN ADDR         14200000
         BR    LNKREG              TO RETRY THE OPERATION               14220000
CKTP20   EQU   *                                                        14240000
         CLI   DECBD+TWENTY8,TP20  TP CODE OF 20                        14280000
         BNE   CKTP11              NO, CHECK OTHERS                     14320000
CHKEOT   EQU   *                                                        14400000
         TM    DECBD+TWENTY4,EOTRSPTX EOT RESPONSE TO TEXT              14420000
         BNO   ABNORMAL            NO, TERMINATE                        14900000
         B     READ                YES, GO GET SENSE STATUS MESSAGE     14950000
CKTP11   EQU   *                                                        14960000
         CLI   DECBD+TWENTY8,TP11  TP CODE OF 11                        14980000
         BNE   ABNORMAL            NO, TERMINATE                        15100000
         B     CHKEOT              YES, CHECK EOT RESPONSE TO TEXT      15150000
CHK61CC  EQU   *                                                        15170000
         CLI   DECBD,SIXTY1        RVI RESPONSE TO ADDRESSING           15190000
         BNE   ABNORMAL            NO, TERMINATE                        15230000
         CLI   DECBD+TWENTY8,TP06  TP CODE OF 6                         15270000
         BNE   CHKTP20             NO, CHECK TP CODE OF 20              15350000
         TM    DECBD+EIGHT,RVIRSP  RVI RESPONSE FLAG ON                 15370000
         BNO   ABNORMAL            NO, TERMINATE                        15390000
         B     READ                YES, GO GET S/S MESSAGE              15430000
CHKTP20  EQU   *                                                        15470000
         CLI   DECBD+TWENTY8,TP20  TP CODE OF 20                        15550000
         BNE   ABNORMAL            NO, TERMINATE                        15570000
         WRITE DECBD,TR,DTFBTR,INAREA,,,0,MF=E                          15590000
         B     CHK7FCC             CHECK COMPLETION CODE                15630000
         EJECT                                                          15670000
CLOSE    EQU   *                                                        15750000
         BTRD  DTFBTR                                                   15770000
         CLOSE DTFBTR                                                   15790000
         EOJ                                                            16050000
         SPACE 5                                                        16100000
SSCHECK  EQU   *                                                        16120000
*     INVESTIGATE THE SENSE/STATUS BYTES SENT BY THE REMOTE DEVICE.     16140000
*  IF RECOVERY IS POSSIBLE, ATTEMPT TO DO SO.  WE SHALL ASSUME THAT     16180000
*  THE ERROR IS UNRECOVERABLE AND TERMINATE.                            16220000
         SPACE 5                                                        16300000
RTNCD40  EQU   *                   DEVICE ASSIGNED TO IGNORE   @DA10720 16320000
ABNORMAL EQU   *                                                        16340000
         STM   REGZERO,REG15,REGSAVE    SAVE REGS                       16380000
*        ONE LINE DELETED BY APAR DA10722                      @DA10722 16420000
         L     WORKREG,=A(IJLBTEND)     GET ENDING ADDRESS     @DA10722 16500000
         PDUMP BASE,(WORKREG)                                  @DA10722 16520000
         EOJ                                                            16540000
         EJECT                                                          16580000
FORMAT0  EQU   *                                                        16620000
         DC    X'0227F5'           STX,ESC,E/W                          16700000
         DC    X'C71140401DE8'     WCC, SBA = 0, SF = PROT,INT @DA10721 16720000
         DC    X'11C150'           SBA = 80                    @DA10721 16740000
         DC    C'GOOD MORNING.'                                         16780000
         DC    X'1D6011C15F'       SF = PROT, SBA = 94                  16820000
         DC    C'THIS BEGINS THE DEMONSTRATION '                        16900000
         DC    C'OF THE DOS/BTAM '                                      16920000
         DC    X'1DE8'             SF = PROT,INT               @DA10721 16940000
         DC    C'3270 '                                                 16980000
         DC    X'1D60'             SF = PROT                            17020000
         DC    C'REMOTE SAMPLE PROGRAM.'                                17100000
         DC    X'1D6011C3F0'       SF = PROT, SBA = 240                 17120000
         DC    C'ENTER THE FOLLOWING:'                                  17140000
         DC    X'1D6011C4D8'       SF = PROT, SBA = 280                 17180000
         DC    C'NAME:'                                                 17550000
         DC    X'1D4013'           SF = UNPROT, IC                      17600000
         DC    X'11C5401D60'       SBA = 320,SF = PROT                  17620000
         DC    C'SOC SEC NUM:'                                          17640000
         DC    X'1D40'             SF = UNPROT                          17680000
         DC    X'11C5E81D60'       SBA = 360,SF = PROT                  17720000
         DC    X'03'               ETX                                  17800000
FMT0SZ   EQU   *-FORMAT0                                                17820000
         SPACE 5                                                        17840000
FORMAT1  EQU   *                                                        17880000
         DC    X'0227F5'           STX,ESC,E/W                          17920000
         DC    X'C71140401D60'     WCC, SBA = 0, SF = PROT     @DA10721 18000000
         DC    X'1140C1'           SBA = 1                     @DA10721 18020000
         DC    C'ENTER DATA REQUESTED BELOW:'                           18040000
         DC    X'11C150'           SBA = 80                             18080000
         DC    C'NAME:'                                                 18120000
         DC    X'1D4013'           SF = UNPROT, IC             @DA10721 18200000
         DC    X'11C1F81D60'       SBA = 120, SF = PROT        @DA10721 18220000
         DC    C'ADDR:'                                                 18240000
         DC    X'1D40'             SF = UNPROT                 @DA10721 18280000
         DC    X'11C2601D60'       SBA = 160, SF = PROT        @DA10721 18320000
         DC    C'CITY:'                                                 18400000
         DC    X'1D40'             SF = UNPROT                 @DA10721 18420000
         DC    X'11C3C81D60'       SBA = 200, SF = PROT        @DA10721 18440000
         DC    C'STATE:'                                                18480000
         DC    X'1D40'             SF = UNPROT                 @DA10721 18520000
         DC    X'11C3E41D60'       SBA = 228, SF = PROT        @DA10721 18600000
         DC    C'ZIP:'                                                  18620000
         DC    X'1D50'             SF = UNPROT,NUM             @DA10721 18640000
         DC    X'11C3F01D60'       SBA = 240, SF = PROT        @DA10721 18680000
         DC    X'11C4D8'           SBA = 280                   @DA10721 18720000
         DC    C'ENTER KEY: ENTER DATA;'                                18800000
         DC    X'11C540'           SBA = 320                            18820000
         DC    C'PA1 KEY: PRINT DATA;'                                  18840000
         DC    X'11C5E8'           SBA = 360                            18880000
         DC    C'PA2 (CNCL) KEY: DEACTIVATE TERMINAL;'                  18920000
         DC    X'11C650'           SBA = 400                            19000000
         DC    C'CLEAR KEY: CONTROL OPTIONS;'                           19020000
         DC    X'03'               ETX                                  19040000
FMT1SZ   EQU   *-FORMAT1                                                19080000
         EJECT                                                          19120000
FORMAT2  EQU   *                                                        19200000
         DC    X'0227F5'           STX,ESC,E/W                          19220000
         DC    X'C711404013'       WCC, SBA = 0, IC                     19240000
         DC    C'XXYY4CCDD'                                             19280000
         DC    X'1140E8'           SBA = 40                             19320000
         DC    C'TO REQUEST BTAM OLT -- ENTER REQUEST FOR TEST MESS'    19400000
         DC    C'AGE OVER SAMPLE FORMAT ABOVE:  XX=TEST NO. (23-28)'    19420000
         DC    C'  YY=REPEATS (01-99) CCDD=ADDRESS OF TARGET DEVICE'    19440000
         DC    C'THEN HIT ERASE EOF AND THEN TEST REQ. USE CLEAR KE'    19480000
         DC    C'Y TO RESUME AFTER TEST.'                               19520000
         DC    X'11C3C8'           SBA = 200                            19600000
         DC    X'03'               ETX                                  19620000
FMT2SZ   EQU   *-FORMAT2                                                19640000
         SPACE 5                                                        20250000
NOPTR    EQU   *                                                        20300000
         DC    X'0227F1'           STX,ESC,WRITE                        20320000
         DC    X'C611C6F71DE8'   WCC, SBA = 339, SF = PROT,INT @DA10721 20340000
         DC    C'NO PRINTER DEFINED FOR THIS PROGRAM'                   20380000
         DC    X'03'               ETX                                  20420000
NOPTRL   EQU   *-NOPTR                                                  20500000
         SPACE 5                                                        20520000
CLOSEMG  EQU   *                                                        20540000
         DC    X'0227F5'           STX,ESC,E/W                          20580000
         DC    X'C71140401DE8'     WCC, SBA = 0, SF = PROT,INT @DA10721 20620000
         DC    C'     THE REMOTE 3270 SAMPLE PROGRAM HAS CONCLUDED.'    20700000
         DC    X'03'               ETX                                  20720000
CLOSEMGL EQU   *-CLOSEMG                                                20740000
         SPACE 5                                                        20780000
         SPACE 5                                                        20820000
READBUF  EQU   *                                                        20900000
         DC    X'0227F203'         STX,ESC,RD BUF,ETX                   20920000
READBUFL EQU   *-READBUF                                                20940000
         SPACE 5                                                        20980000
ERALUNP  EQU   *                                                        21020000
         DC    X'02276F03'         STX,ESC,EAU,ETX                      21100000
ERALUNPL EQU   *-ERALUNP                                                21120000
         EJECT                                                          21400000
*        READ AND WRITE MACROS                                          21450000
         DS    0F                                                       21500000
WRITETI  EQU   *                                                        21550000
         WRITE DECBD,TI,DTFBTR,(MSGADDR),(MSGLEN),(SELREG),0,MF=E       21600000
         BR    LNKREG                                                   21650000
         SPACE 5                                                        21700000
READTI   EQU   *                                                        21750000
         READ  DECBD,TI,DTFBTR,INAREA,300,POLDSPLY,0,MF=E               21800000
         BR    LNKREG                                                   21850000
         EJECT                                                          21900000
READTRV  EQU   *                                                        21950000
         READ  DECBD,TRV,DTFBTR,INAREA,300,,0,MF=E                      22000000
         BR    LNKREG              RETURN                               22050000
         SPACE 5                                                        22100000
WRITETIV EQU   *                                                        22150000
         WRITE DECBD,TIV,DTFBTR,((MSGADDR),INAREA),((MSGLEN),300),(SELRX22200000
               EG),0,MF=E                                               22250000
         BR    LNKREG              RETURN                               22300000
         EJECT                                                          22350000
READTT   EQU   *                                                        22400000
         READ  DECBD,TT,DTFBTR,(MSGADDR),300,,0,MF=E                    22450000
         BR    LNKREG              RETURN                               22500000
         EJECT                                                          22550000
*        DISPLAY SELECTION ADDRESSES                                    22600000
*   THE CURRENT MACRO OPERANDS ARE FOR TWO REMOTE 3270 DISPLAYS;        22650000
*                          1. 0TH CU, 0TH DEV (60604040)                22700000
*                          2. 0TH CU, 1ST DEV (6060C1C1)                22750000
SELDSPLY DFTRMLST OPENLST,(606040402D,6060C1C12D)                       22800000
         SPACE 5                                                        22850000
*    DISPLAY SPECIFIC POLLING ADDRESSES                                 22900000
*   THE CURRENT MACRO OPERANDS ARE FOR TWO REMOTE 3270 DISPLAYS:        22950000
*                          1. 0TH CU, 0TH DEV (40404040)                23000000
*                          2. 0TH CU, 1ST DEV (4040C1C1)                23050000
SPECPOL  DFTRMLST OPENLST,(404040402D,4040C1C12D)                       23100000
         EJECT                                                          23150000
*        DISPLAY GENERAL POLLING ADDRESS                                23200000
POLDSPLY DFTRMLST AUTOWLST,3732,40407F7F2D                              23250000
         SPACE 5                                                        23300000
         SPACE 5                                                        23350000
*        CONSTANTS                                                      23400000
H4096    DC    H'4096'                                                  23450000
EIGHT8   DC    F'8'                CONSTANT OF 8                        23500000
DSPTAB   DC    XL32'0'             DISPLAY TABLE                        23550000
TWELVE   DC    F'12'               LENGTH OF 12                         23600000
INDEX    DC    X'00'               INDEX BYTE SAVE AREA                 23650000
CUDVSAVE DC    X'0000'             CU,DV SAVEAREA                       23700000
SELSAVE  DC    F'0'                                                     23750000
NOPRNTR  DC    X'0000000000'                                            23800000
SAVER    DC    D'0'                                                     23850000
SIXL     DC    F'6'                                                     23900000
INAREA   DC    500F'0'             INPUT AREA                           23950000
INAREAL  EQU   *-INAREA                                                 24000000
REGSAVE  DC    16F'0'              REGISTER SAVE AREA                   24050000
         DS    0F                                                       24100000
*        ONE LINE DELETED BY APAR DA10722                      @DA10722 24150000
DECBADDR DC    X'80'                                                    24200000
         DC    AL3(DECBD)                                               24250000
         EJECT                                                          24300000
RMSRTAB  RMSRTAB 1,                                            @DA10721 24350000
         SPACE 5                                                        24400000
DTFBTR   DTFBT LINELST=(005),SWITCH=NO,CU=2703,DEVICE=BSC3,CONFIG=MPT, X24450000
               MODELST=(0),CTLCHAR=EBCDIC,MODNAME=R3270MOD,TERMTST=YES,X24500000
               LERBADR=RMSRTAB                                 @DA10721 24550000
         SPACE 5                                                        24600000
         READ  DECBD,TI,DTFBTR,MF=L                                     24650000
         LTORG                                                          24700000
         EJECT                                                          24750000
R3270MOD BTMOD BSCS=YES,BSCMPT=YES,BSCTEST=YES,DECBEXT=YES,RMSR=YES 4-0 24800000
         END                                                            24850000
        BKEND
/*


