./ ADD NAME=NODSI       01 01 94328 94336 211554 0149 0144 0001 IBMUSER
//IBMUSERA JOB ,'JAN JAEGER',MSGCLASS=H,                                00000100
//          NOTIFY=IBMUSER                                              00000200
//ASMA90   EXEC PGM=ASMA90,PARM=(DECK,NOOBJECT)                         00000300
//SYSPRINT DD  SYSOUT=*                                                 00000400
//SYSLIB   DD  DSN=SYS1.MACLIB,DISP=SHR                                 00000500
//         DD  DSN=SYS1.MODGEN,DISP=SHR                                 00000600
//SYSUT1   DD  SPACE=(CYL,1),UNIT=SYSALLDA                              00000700
//SYSPUNCH DD  DSN=&&PUNCH,DISP=(NEW,PASS),                             00000800
//          SPACE=(TRK,1),UNIT=SYSALLDA                                 00000900
 TITLE 'BYPASS ENQ PROCESSING FOR DATASETS'                             00001000
*********************************************************************** 00001100
*                                                                     * 00001200
* JUSTIFICATION:                                                      * 00001300
*   MVS DOES NOT SUPPLY A FUNCTION TO DELETE/RENAME/ALTER DATASETS    * 00001400
*   THAT HAVE ENQ'S AGAINST DUPLICATES.                               * 00001500
*   THIS PROGRAM WILL SUPPLY THAT FUNCTION.                           * 00001600
*                                                                     * 00001700
* FUNCTION:                                                           * 00001800
*   THIS PROGRAM WILL PASS CONTROL TO THE PROGRAM NAMED ON THE PARM   * 00001900
*   STATEMENT, AND INTERCEPT ALL SYSDSN ENQ'S ISSUED BY THAT PROGRAM  * 00002000
*   SO THAT RNAMES ENQUEUED UPON CAN BE PROCESSED AS IF THEY HAD NO   * 00002100
*   ACTIVE ENQ AGAINST THEM.                                          * 00002200
*   ALL ENQUEUES WITH SCOPE=SYSTEM OR SCOPE=SYSTEMS WILL BE CONVERTED * 00002300
*   TO SCOPE=STEP.  THIS SO THAT PROGRAMS ISSUEING THOSE ENQUEUES     * 00002400
*   CAN STILL RELY ON VALID RETURNCODES FROM GRS FOR THE ENQUEUES     * 00002500
*   AND DEQUEUES DONE.                                                * 00002600
*                                                                     * 00002700
* EXAMPLE:                                                            * 00002800
*   //T2JJA    JOB ,'JAN JAEGER'                                      * 00002900
*   //NODSI    EXEC PGM=NODSI,PARM='IEHPROGM,LINECNT=66'              * 00003000
*   //VOLDD    DD  UNIT=3380,VOL=SER=STOR01,DISP=OLD                  * 00003100
*   //SYSPRINT DD  SYSOUT=*                                           * 00003200
*   //SYSIN    DD  *                                                  * 00003300
*    SCRATCH DSNAME=T2JJ.ZZ,VOL=3380=STOR01                           * 00003400
*   /*                                                                * 00003500
*                                                                     * 00003600
* LOGIC:                                                              * 00003700
*   OBTAIN WORKAREA IN KEY7                                           * 00003800
*   EXTRACT PROGRAM NAME FROM PARM= STATEMENT, AND BUILD NEW          * 00003900
*    PARAMETER AREA                                                   * 00004000
*   ISSUE RACROUTE TO VERIFY USER ACCESS TO THIS FACILITY             * 00004100
*   ATTACH PROGRAM WITH RSAPF=YES AND DISP=NO                         * 00004200
*   BUILD SVC SCREENING TABLE FOR ENQ/DEQ/RESERVE SVC'S               * 00004300
*   SET NEWLY ATTACHED TCB DISPATCHABLE                               * 00004400
*   WAIT FOR TCB TO TERMINATE                                         * 00004500
*   SAVE RETURNCODE                                                   * 00004600
*   RELEASE WORKAREA AND EXIT WITH RC FROM ATTACHED PROGRAM           * 00004700
*                                                                     * 00004800
* SVC INTERCEPT ROUTINE:                                              * 00004900
*   ENTER AMODE AND PSW KEY FROM CALLER                               * 00005000
*   CHANGE SVC PARAMTER LIST SO THAT ENQUEUES FOR SYSDSN ARE          * 00005100
*   CONVERTED TO SCOPE=STEP                                           * 00005200
*   RESET PSW KEY TO ZERO                                             * 00005300
*   BRANCH-ENTER ORIGINAL SVC EPA.                                    * 00005400
*                                                                     * 00005500
* RACF OR ACF2:                                                       * 00005600
*   ACCESS(READ) IS REQUIRED TO ENTITY(NODSI) IN CLASS(FACILITY) TO   * 00005700
*   USE THIS FACILITY.  ACCESS WILL BE DENIED IF NO PROFILE EXISTS.   * 00005800
*                                                                     * 00005900
* REGISTER USAGE (MAIN PROGRAM):                                      * 00006000
*   R0-R5 WORK                                                        * 00006100
*   R6    PROGRAM BASE                                                * 00006200
*   R7    ATTACHED PROGRAM PARM AREA                                  * 00006300
*   R8    ATTACHED PROGRAM TCB ADDRESS                                * 00006400
*   R9    JSCB ADDRESS                                                * 00006500
*   R10   APF INDICATOR FROM JSCBOPTS(JSCBPASS)                       * 00006600
*   R11   PSW KEY OF CALLER                                           * 00006700
*   R12   PROGRAM BASE                                                * 00006800
*   R13   KEY7 WORKAREA INCLUDING STANDARD OS SAVEAREA                * 00006900
*   R14   RETURN ADDR                                                 * 00007000
*   R15   ENTRY POINT ADDRESS + RETURN CODE                           * 00007100
* REGISTER USAGE (INTERCEPT ROUTINE):                                 * 00007200
*   R6    PROGRAM BASE                                                * 00007300
*   R2,R11,R12 WORK                                                   * 00007400
*   OTHERS AS DEFINED BY SVC LINKAGE CONVENTIONS                      * 00007500
*                                                                     * 00007600
* ATTRIBUTES:                                                         * 00007700
*   AMODE(31),RMODE(24),REFR,AC(1)                                    * 00007800
*                                                                     * 00007900
* HISTORY:                                                            * 00008000
*   DATE       BY              COMMENTS                               * 00008100
*   30/11/94   JAN JAEGER      INITIAL VERSION                        * 00008200
*                                                                     * 00008300
*********************************************************************** 00008400
JJ$NODSI RSECT ,                                                        00008500
JJ$NODSI AMODE 31                                                       00008600
JJ$NODSI RMODE 24                                                       00008700
         B     SKIPHDR-*(,R15)         BRANCH AROUND EYE CATCHER        00008800
         DC    AL1(L'EYECATCH)                                          00008900
EYECATCH DC    C'JJ$NODSI-J.JAEGER-&SYSDATE.-&SYSTIME.'                 00009000
SKIPHDR  DS    0H                                                       00009100
         BAKR  R14,0                   STACK REGISTERS AND SET RETADDR  00009200
         BASR  R6,0                    SET BASE REGISTER                00009300
         LA    R2,*-JJ$NODSI                                            00009400
         SLR   R6,R2                                                    00009500
         USING JJ$NODSI,R6                                              00009600
*                                                                       00009700
         L     R3,0(,R1)               PARAMETER POINTER                00009800
         LA    R3,0(,R3)               ZERO BIT 31                      00009900
*                                                                       00010000
         MODESET MODE=SUP                                               00010100
         IPK   ,                                                        00010200
         LR    R11,R2                  SAVE PSWKEY                      00010300
         SPKA  X'70'                                                    00010400
*                                                                       00010500
         STORAGE OBTAIN,               OBTAIN WORKAREA                 X00010600
               LENGTH=WORKLEN,                                         X00010700
               CALLRKY=YES,                                            X00010800
               LOC=BELOW,                                              X00010900
               SP=129                                                   00011000
         MVC   4(4,R1),=CL4'F1SA'      INDICATE LINKAGE STACK USED      00011100
         LR    R13,R1                                                   00011200
         USING WORKAREA,R13                                             00011300
*                                                                       00011400
         EJECT ,                                                        00011500
*                                                                       00011600
         SPKA  0(R11)                                                   00011700
         LH    R4,0(,R3)               PARAMETER LENGTH                 00011800
         LTR   R4,R4                   NO LENGTH                        00011900
         BZ    PRMERR                                                   00012000
         BCTR  R4,0                    REDUCE TO MACHINE LENGTH         00012100
         CH    R4,=H'8'                IF MORE THEN 9                   00012200
         BNH   NOPRMLIM                                                 00012300
         LH    R4,=H'8'                THEN LIMIT TO 9                  00012400
NOPRMLIM DS    0H                                                       00012500
         SLR   R2,R2                   TR BYTE FOUND INDICATOR          00012600
         EX    R4,FINDDLM              FIND A DELIMITER                 00012700
         BC    B'0110',DLMFOUND        FOUND A DELIMITER                00012800
         CH    R4,=H'8'                DO WE HAVE MORE THEN 8           00012900
         BNE   DLM8                    YES FALL THROUGH                 00013000
         B     PRMERR                                                   00013100
DLMFOUND DS    0H                                                       00013200
         SLR   R1,R3                   SUBTRACT START ADDRESS OF PARM   00013300
         SH    R1,=H'2'                SUBTRACT LENGTH HW               00013400
         LTR   R4,R1                                                    00013500
         BZ    PRMERR                  ZERO LENGTH THEN ERROR           00013600
         BCTR  R4,0                    SET MACHINE LENGHT               00013700
DLM8     DS    0H                                                       00013800
         SPKA  X'70'                                                    00013900
         XC    EPNAME,EPNAME                                            00014000
         LR    R0,R4                   COPY LENGHT TO R0                00014100
         LR    R1,R11                  COPY SOURCE KEY TO R1            00014200
         MVCSK EPNAME,2(R3)            COPY EPNAME                      00014300
         OC    EPNAME,=CL8' '          FORCE UPPERCASE AND BLANKS       00014400
         SPKA  0(R11)                                                   00014500
         LH    R5,0(,R3)               RELOAD PARM LENGTH               00014600
         BCTR  R5,0                    SET MACHINE LENGTH               00014700
         LTR   R2,R2                   CHECK FOR DELIMITER              00014800
         BZ    NODLM                                                    00014900
         BCTR  R5,0                    SUBTRACT DELIMITER               00015000
NODLM    DS    0H                                                       00015100
         SLR   R5,R4                   SUBTRACT EPNAME LENGTH           00015200
         LA    R2,4(R4,R3)             POINT IN ORIGINAL PARM           00015300
*                                                                       00015400
         LA    R10,USERPLEN(,R5)       TOTAL LENGTH OF USERPARM         00015500
         STORAGE OBTAIN,               GET STORAGE FOR PARM AREA       X00015600
               LENGTH=(10),                                            X00015700
               CALLRKY=YES,                                            X00015800
               LOC=BELOW,                                              X00015900
               SP=130                                                   00016000
         LR    R7,R1                                                    00016100
         USING USERPARM,R7                                              00016200
         LA    R1,PARMLEN                                               00016300
         ST    R1,PARMADDR             STORE PARM ADDRESS               00016400
         OI    PARMADDR,X'80'          FORCE END-OF-LIST INDICATOR ON   00016500
         STH   R5,PARMLEN              STORE PARM LENGTH                00016600
         LTR   R5,R5                   IS A PARM SPECIFIED              00016700
         BZ    NOUPARM                 NO THEN DO NOT COPY              00016800
         BCTR  R5,0                                                     00016900
         EX    R5,MVCPRM               COPY INTO NEW PARM AREA          00017000
NOUPARM  DS    0H                                                       00017100
*                                                                       00017200
         EJECT ,                                                        00017300
*                                                                       00017400
         SPKA  X'70'                                                    00017500
         MVC   RACROUTE,MFLROUTE       INITIALIZE PARMLIST              00017600
         RACROUTE REQUEST=AUTH,        REQUEST ACCESS                  X00017700
               RELEASE=1.9,            MINIMUM LVL TO SUPPORT ENTITYX  X00017800
               WORKA=SAFWK,                                            X00017900
               MF=(E,RACROUTE)                                          00018000
         LTR   R8,R15                  CHECK ACCESS                     00018100
         BNZ   AUTHERR                                                  00018200
*                                                                       00018300
         EJECT ,                                                        00018400
*                                                                       00018500
         L     R9,PSATOLD-PSA(,0)      REMOVE APF AUTHORISATION         00018600
         ICM   R9,B'0111',TCBJSCBB-TCB(R9)                              00018700
         USING IEZJSCB,R9                                               00018800
         SPKA  X'00'                                                    00018900
         NI    JSCBOPTS,255-JSCBAUTH                                    00019000
         SPKA  X'70'                                                    00019100
*                                                                       00019200
         EJECT ,                                                        00019300
*                                                                       00019400
         LR    R1,R7                   SET PARM REGISTER FOR ATTACH     00019500
         XC    STECB,STECB                                              00019600
         MVC   LATT,LATTI                                               00019700
         ATTACH ECB=STECB,             ATTACH USER PGM                 X00019800
               EPLOC=EPNAME,                                           X00019900
               SF=(E,LATT)                                              00020000
         LTR   R8,R15                                                   00020100
         BNZ   ATTERR                                                   00020200
         ST    R1,STTCB                STORE TCB ADDRESS                00020300
         LR    R8,R1                                                    00020400
         USING TCB,R8                                                   00020500
*                                                                       00020600
         SPKA  X'00'                                                    00020700
         STORAGE OBTAIN,               OBTAIN STORAGE FOR SCREENING    X00020800
               LENGTH=SVCSCRNL,        TABLE                           X00020900
               SP=254                                                   00021000
         LR    R2,R1                                                    00021100
         USING SVCSCRN,R2                                               00021200
         MVC   SVCSCHDR,SVCSTHDR       COPY SVC SCREENING HEADER        00021300
         MVC   SVCSCTBL,SVCSTTBL       COPY SVC SCREENING TABLE         00021400
         ST    R2,TCBSVCA2             STORE SCREENING TABLE IN TCB     00021500
         DROP  R2                                                       00021600
         OI    TCBFLGS7,TCBSVCS+TCBSVCSP   SET SCREENING ACTIVE         00021700
*                                                                       00021800
         ATTACH DISP=RESET,            KICK OFF USER PGM               X00021900
               TCB=(8)                                                  00022000
         WAIT  ECB=STECB               WAIT FOR SUBTASK TO COMPLETE     00022100
*                                                                       00022200
         NI    TCBFLGS7,255-(TCBSVCS+TCBSVCSP)   SET SCREENING INACTIVE 00022300
         XC    TCBSVCA2,TCBSVCA2       REMOVE SCREENING TABLE ADDRESS   00022400
         STORAGE RELEASE,              RELEASE STORAGE FOR SCREENING   X00022500
               LENGTH=SVCSCRNL,        TABLE                           X00022600
               ADDR=(2),                                               X00022700
               SP=254                                                   00022800
         SPKA  X'70'                                                    00022900
         DROP  R8                                                       00023000
*                                                                       00023100
         DETACH STTCB                  REMOVE SUBTASK                   00023200
*                                                                       00023300
         EJECT ,                                                        00023400
*                                                                       00023500
         SPKA  X'00'                                                    00023600
         NI    JSCBOPTS,255-JSCBAUTH   REMOVE APF AUTHORISATION         00023700
         DROP  R9                                                       00023800
*                                                                       00023900
         SPKA  0(R11)                                                   00024000
         STORAGE RELEASE,              RELEASE PARM DATA AREA          X00024100
               LENGTH=(10),                                            X00024200
               ADDR=(7),                                               X00024300
               CALLRKY=YES,                                            X00024400
               SP=130                                                   00024500
         SPKA  X'70'                                                    00024600
*                                                                       00024700
         SLR   R8,R8                   SAVE RETURNCODE                  00024800
         ICM   R8,B'0111',STECB+1                                       00024900
*                                                                       00025000
         LR    R1,R13                                                   00025100
         STORAGE RELEASE,              WORKAREA                        X00025200
               LENGTH=WORKLEN,                                         X00025300
               ADDR=(1),                                               X00025400
               CALLRKY=YES,                                            X00025500
               SP=129                                                   00025600
*                                                                       00025700
         MODESET MODE=PROB,            BACK TO PROBLEMSTATE USERKEY    X00025800
               KEY=NZERO                                                00025900
*                                                                       00026000
         LR    R15,R8                  RESTORE RETURNCODE               00026100
         PR    ,                       RETURN TO CALLER                 00026200
*                                                                       00026300
         EJECT ,                                                        00026400
*                                                                       00026500
SVCROUTR DS    0D                      SVC SCREENING INTERCEPT ADDRESS  00026600
         BASR  R6,0                    ESTABLISH PROGRAM BASE           00026700
         LA    R2,*-JJ$NODSI                                            00026800
         SLR   R6,R2                                                    00026900
*                                                                       00027000
         L     R2,RBLINK-RBBASIC(,R5)  GO UP ONE RB LEVEL (TYPE 2-4)    00027100
*                                                                       00027200
         IC    R11,RBOPSWB2-RBBASIC(,R2)                                00027300
         SPKA  0(R11)                  SET PSWKEY OF CALLER             00027400
         TM    RBOPSWA-RBBASIC(R2),RBOPSWM                              00027500
         BO    STAY31                                                   00027600
         LA    R12,MODE24              ENTER AMODE OF CALLER            00027700
         BSM   0,R12                                                    00027800
MODE24   DS    0H                                                       00027900
STAY31   DS    0H                                                       00028000
         LR    R12,R1                                                   00028100
CHECKARG DS    0H                                                       00028200
         LR    R11,R12                                                  00028300
         TM    2(R12),B'01000000'      IS THIS SCOPE=SYSTEM(S)          00028400
         BZ    NOEQDQ                                                   00028500
         L     R10,4(,R12)                                              00028600
         CLC   =CL8'SYSDSN',0(R10)     IS THIS QNAME=SYSDSN             00028700
         BNE   NOSDQN                                                   00028800
         NI    2(R12),B'10110111'      CHANGE TO SCOPE=STEP             00028900
NOEQDQ   DS    0H                                                       00029000
         TM    2(R12),B'00001000'      WAS THIS A RESERVE               00029100
         BZ    NOSDQN                                                   00029200
         LA    R12,4(,R12)             SKIP UCB= PARM                   00029300
NOSDQN   DS    0H                                                       00029400
         LA    R12,12(,R12)            ADVANCE TO NEXT ENTRY            00029500
         TM    0(R11),B'10000000'      WAS THIS LAST IN LIST            00029600
         BZ    CHECKARG                GO PROCESS NEXT ENTRY IN LIST    00029700
         L     R12,=A(MODE31+X'80000000')                               00029800
         BSM   0,R12                   BACK TO AMODE 31                 00029900
MODE31   DS    0H                                                       00030000
         SPKA  X'00'                     AND KEY ZERO                   00030100
*                                                                       00030200
         SL    R2,=AL4(RBBASIC-RBPREFIX) BACKUP TO RB PREFIX            00030300
         LH    R2,RBINTCOD-RBPREFIX(,R2) LOAD INTERRUPTION CODE         00030400
         SLL   R2,3                      MULTIPLY BY 8                  00030500
         L     R6,CVTABEND-CVT(,R3)      FIND THE SVC TABLE             00030600
         L     R6,SCVTSVCT-SCVTSECT(,R6)                                00030700
         L     R6,SVCEP-SVCENTRY(R2,R6)  USE INTCOD AS INDEX IN TABLE   00030800
         BSM   0,R6                    BRANCH TO ORIGINAL SVC ROUTINE   00030900
*                                                                       00031000
         EJECT ,                                                        00031100
*                                                                       00031200
FINDDLM  TRT   2(0,R3),DLMTBL          TR TABLE TO FIND DELIMITER       00031300
MVCPRM   MVC   PARMSTR(0),0(R2)        COPY PARAMETER STRING            00031400
*                                                                       00031500
PRMERR   DS    0H                      PARAMETER ERROR                  00031600
         WTO   MF=(E,PRMERRM)                                           00031700
         ABEND 999,,STEP                                                00031800
*                                                                       00031900
AUTHERR  DS    0H                      AUTHORISATION ERROR              00032000
         WTO   MF=(E,AUTHERRM)                                          00032100
         ABEND 999,REASON=(8),,STEP    RACROUTE RC IS REASON CODE       00032200
*                                                                       00032300
ATTERR   DS    0H                      ATTACH ERROR                     00032400
         WTO   MF=(E,ATTERRM)                                           00032500
         ABEND 999,REASON=(8),,STEP    ATTACH RC IS REASON CODE         00032600
*                                                                       00032700
MFLROUTE RACROUTE REQUEST=AUTH,        REQUEST ACCESS                  X00032800
               RELEASE=1.9,            MINIMUM LVL TO SUPPORT ENTITYX  X00032900
               CLASS='FACILITY',       RESOURCE CLASS                  X00033000
               ENTITYX=ENTITYX,        PROFILE NAME                    X00033100
               ATTR=READ,              ACCESS(READ)                    X00033200
               RACFIND=YES,            FORCE ICH MSG IF NO PROFILE     X00033200
               MF=L                                                     00033300
MFLROUTL EQU   *-MFLROUTE                                               00033400
*                                                                       00033500
ENTITYX  DC    2AL2(L'PROFNAME)                                         00033600
PROFNAME DC    C'NODSI'                PROFILE NAME                     00033700
*                                                                       00033800
LATTI    ATTACH EPLOC=,                                                X00033900
               ECB=,                                                   X00034000
               JSTCB=YES,              IF THIS PROGRAM IS TO BE CALLED X00034100
               RSAPF=YES,              FROM IKJEFT01, THEN JSTCB=NO    X00034200
               DISP=NO,                MUST BE CODED                   X00034300
               SF=L                                                     00034400
LATTL    EQU   *-LATTI                                                  00034500
*                                                                       00034600
PRMERRM  WTO   'JJ$001E PARAMETER ERROR',MCSFLAG=HRDCPY,MF=L            00034700
AUTHERRM WTO   'JJ$002E AUTHORISATION FAILURE',MCSFLAG=HRDCPY,MF=L      00034800
ATTERRM  WTO   'JJ$003E ATTACH FAILED',MCSFLAG=HRDCPY,MF=L              00034900
*                                                                       00035000
         EJECT ,                                                        00035100
*                                                                       00035200
SVCSTHDR DC    0D'0',AL4(SVCROUTR+X'80000000'),AL1(SVCTP34,0,0,0)       00035300
SVCSTTBL DC    256X'80'                                                 00035400
         ORG   SVCSTTBL+48             ENQ/RESERVE                      00035500
         DC    X'00'                                                    00035600
         ORG   SVCSTTBL+56             DEQ                              00035700
         DC    X'00'                                                    00035800
         ORG   ,                                                        00035900
*                                                                       00036000
DLMTBL   DC    XL256'00'               DELIMITER TABLE                  00036100
         ORG   DLMTBL+C' '             ONLY                             00036200
         DC    C' '                      SPACE                          00036300
         ORG   DLMTBL+C','                 AND                          00036400
         DC    C','                          COMMA                      00036500
         ORG   ,                               ARE VALID DELIMITERS     00036600
*                                                                       00036700
         LTORG ,                                                        00036800
*                                                                       00036900
         EJECT ,                                                        00037000
*                                                                       00037100
WORKAREA DSECT ,                       KEY 7 WORKAREA                   00037200
SAVEAREA DS    18F                                                      00037300
STECB    DS    1F                      ECB ADDRESS FOR ATTACH           00037400
STTCB    DS    1F                      TCB ADDRESS RETURNED BY ATTACH   00037500
EPNAME   DS    CL8                     EPNAME FOR ATTACH EPLOC=         00037600
LATT     DS    XL(LATTL)               ATTACH WORK AREA                 00037700
RACROUTE DS    XL(MFLROUTL)            WORKAREA FOR RACROUTE            00037800
SAFWK    DS    XL512                   WORKAREA FOR SAF                 00037900
WORKLEN  EQU   *-WORKAREA                                               00038000
*                                                                       00038100
SVCSCRN  DSECT ,                       KEY 0 SCREENING TABLE            00038200
SVCSCHDR DS    1D                                                       00038300
SVCSCTBL DS    XL256                                                    00038400
SVCSCRNL EQU   *-SVCSCRN                                                00038500
*                                                                       00038600
USERPARM DSECT ,                       USERKEY PARAMETERAREA            00038700
PARMADDR DS    1F                      POINTER TO USERPARM              00038800
PARMLEN  DS    1H                      LENGTH OF USERPARM               00038900
PARMSTR  DS    0C                      USERPARM                         00039000
USERPLEN EQU   *-USERPARM              USERPARM HEADER LENGTH           00039100
*                                                                       00039200
         EJECT ,                                                        00039300
*                                                                       00039400
         IHAPSA ,                                                       00039500
         CVT   DSECT=YES                                                00039600
         IHASCVT ,                                                      00039700
         IKJTCB ,                                                       00039800
         IKJRB ,                                                        00039900
         IHACDE ,                                                       00040000
         IHASVC ,                                                       00040100
         IEZJSCB ,                                                      00040200
         YREGS ,                                                        00040300
*                                                                       00040400
         END   ,                                                        00040500
//LKED     EXEC PGM=HEWL,PARM='REFR,AMODE=31,RMODE=24,AC=1'             00040600
//SYSPRINT DD  SYSOUT=*                                                 00040700
//SYSUT1   DD  SPACE=(CYL,1),UNIT=SYSALLDA                              00040800
//SYSLMOD  DD  DSN=SYS1.LINKLIB(NODSI),DISP=SHR                         00040900
//SYSLIN   DD  DSN=&&PUNCH,DISP=(OLD,DELETE)                            00041000
