*ASM XOPTS(SP)                                                          00010000
*        Copyright Russell Evans 2002                                   00020000
**********************************************************************  00030000
*      REESYST  - inquire system utility                             *  00040000
**********************************************************************  00050000
*                                                                    *  00060000
* Module Name : REESYST                                              *  00070000
**********************************************************************  00080000
REESYST  TITLE   'inquire system utility'                               00090000
*                                                                       00100000
         DFHREGS ,                                                      00110000
BASEREG  EQU   10                                                       00120000
DATAREG  EQU   4                                                        00130000
INPUTREG EQU   5                                                        00140000
EIBBAR   EQU   6                                                        00150000
*                                                                       00160000
         COPY  DFHAID              Attention Id's                       00170000
         COPY  DFHBMSCA            BMS Attribute bytes                  00180000
*                                                                       00190000
**********************************************                          00200000
*  STORAGE                                                              00210000
**********************************************                          00220000
*                                                                       00230000
DFHEISTG DSECT                                                          00240000
WS_WORK  DS    2D                work area for unpack                   00241002
WS_CVD   DS    D                 work area for convert                  00242002
WS_RESP  DS    F                 General purpose resp field             00250000
DSA      DS    F                 total DSA below                        00260000
EDSA     DS    F                 total DSA above                        00260100
CDSA     DS    F                 CICS DSA below                         00261000
ECDSA    DS    F                 CICS DSA above                         00262000
ERDSA    DS    F                 CICS RDSA above                        00263000
RDSA     DS    F                 CICS RDSA below                        00263100
ESDSA    DS    F                 CICS Shared DSA above                  00264000
SDSA     DS    F                 CICS Shared DSA below                  00264100
EUDSA    DS    F                 User DSA above                         00265000
UDSA     DS    F                 User DSA below                         00266000
STATUS   DS    F                 CICS Status                            00270000
RENT     DS    F                 Re-enterent programs protected?        00281000
START    DS    F                 was start warm/cold/emer?              00282000
STORPROT DS    F                 Storage protection on/off              00283000
TRANSISO DS    F                 transaction isolation active?          00284002
OUTLEN   DS    H                 length for send                        00285002
JOBNAME  DS    CL8               MVS job name                           00286002
         PRINT GEN                                                      00330000
REESYST  DFHEIENT CODEREG=(BASEREG),EIBREG=(EIBBAR),DATAREG=(DATAREG)   00340000
REESYST  AMODE 31                                                       00350000
REESYST  RMODE ANY                                                      00360000
*                                                                       00370000
A100     DS    0H                 Overall processing control            00380000
*                                                                       00390000
         EXEC  CICS INQUIRE SYSTEM                                     *00400000
               DSALIMIT(DSA)                                           X00410000
               EDSALIMIT(EDSA)                                         X00420000
               CDSASIZE(CDSA)                                          X00421002
               ECDSASIZE(ECDSA)                                        X00422002
               ERDSASIZE(ERDSA)                                        X00423002
               RDSASIZE(RDSA)                                          X00424002
               ESDSASIZE(ESDSA)                                        X00425002
               SDSASIZE(SDSA)                                          X00426002
               EUDSASIZE(EUDSA)                                        X00427002
               UDSASIZE(UDSA)                                          X00428002
               JOBNAME(JOBNAME)                                        X00429002
               REENTPROTECT(RENT)                                      X00429102
               STARTUP(START)                                          X00429202
               STOREPROTECT(STORPROT)                                  X00429302
               TRANISOLATE(TRANSISO)                                   X00429402
               RESP(WS_RESP)                                            00430000
         CLC   WS_RESP,DFHRESP(NORMAL)      did inquire work?           00431002
         BNE   INQ_FAILED                   no, skip the rest           00432002
*                                                                       00440000
SENDIT   DS    0H                                                       00630000
         L     R1,DSA                      get amount                   00631002
         BAS   R7,CONVERT                  go convert it                00632002
         MVC   OUTDSA,WS_WORK+7            and move to output           00633002
*                                                                       00634002
         L     R1,EDSA                     get amount                   00635002
         BAS   R7,CONVERT                  go convert it                00636002
         MVC   OUTEDSA,WS_WORK+7           and move to output           00637002
*                                                                       00638002
         L     R1,CDSA                     get amount                   00639002
         BAS   R7,CONVERT                  go convert it                00639102
         MVC   OUTCDSA,WS_WORK+7           and move to output           00639202
*                                                                       00639302
         L     R1,ECDSA                    get amount                   00639402
         BAS   R7,CONVERT                  go convert it                00639502
         MVC   OUTECDSA,WS_WORK+7          and move to output           00639602
*                                                                       00639702
         L     R1,ERDSA                    get amount                   00639802
         BAS   R7,CONVERT                  go convert it                00639902
         MVC   OUTERDSA,WS_WORK+7          and move to output           00640002
*                                                                       00640102
         L     R1,RDSA                     get amount                   00640202
         BAS   R7,CONVERT                  go convert it                00640302
         MVC   OUTRDSA,WS_WORK+7           and move to output           00640402
*                                                                       00640502
         L     R1,ESDSA                    get amount                   00640602
         BAS   R7,CONVERT                  go convert it                00640702
         MVC   OUTESDSA,WS_WORK+7          and move to output           00640802
*                                                                       00640902
         L     R1,SDSA                     get amount                   00641002
         BAS   R7,CONVERT                  go convert it                00641102
         MVC   OUTSDSA,WS_WORK+7           and move to output           00641202
*                                                                       00641302
         L     R1,EUDSA                    get amount                   00641402
         BAS   R7,CONVERT                  go convert it                00641502
         MVC   OUTEUDSA,WS_WORK+7          and move to output           00641602
*                                                                       00641702
         L     R1,UDSA                     get amount                   00641802
         BAS   R7,CONVERT                  go convert it                00641902
         MVC   OUTUDSA,WS_WORK+7           and move to output           00642002
*                                                                       00642102
         MVC   OUTJOB,JOBNAME              save job name                00642202
         MVC   OUTRENT,ACTIVE              preset to rent protect       00642302
         CLC   RENT,DFHVALUE(REENTPROT)    is it?                       00642402
         BE    RENTYES                     yes, continue                00642502
         MVC   OUTRENT,INACTIVE            No, set to rent inact        00642602
RENTYES  DS    0H                                                       00642702
         MVC   OUTSTOR,ACTIVE              preset to rent protect       00642802
         CLC   STORPROT,DFHVALUE(ACTIVE)   is it?                       00642902
         BE    STORYES                     yes, continue                00643002
         MVC   OUTSTOR,INACTIVE            No, set to rent inact        00643102
STORYES  DS    0H                                                       00643202
         MVC   OUTISO,ACTIVE               preset to transiso act       00643302
         CLC   TRANSISO,DFHVALUE(ACTIVE)   is it?                       00643402
         BE    ISOYES                      yes, continue                00643502
         MVC   OUTISO,INACTIVE             No, set to ISO inact         00643602
ISOYES   DS    0H                                                       00643702
         MVC   OUTSTART,=CL9'COLD'         preset to cold start         00643802
         CLC   START,DFHVALUE(COLDSTART)   is it?                       00643902
         BE    DONESTRT                    yes, continue                00644002
         MVC   OUTSTART,=CL9'EMERGENCY'    preset to emer start         00644102
         CLC   START,DFHVALUE(EMERGENCY)   is it?                       00644202
         BE    DONESTRT                    yes, continue                00644302
         MVC   OUTSTART,=CL9'WARM'         preset to emer start         00644402
DONESTRT DS    0H                                                       00644502
         EXEC CICS SEND TEXT FROM(OUTTXT) LENGTH(TXTLEN)               X00644602
             ERASE FREEKB NOHANDLE                                      00645002
         EXEC CICS RETURN                                               00650000
INQ_FAILED    DS 0H                                                     00660002
         EXEC CICS SEND TEXT FROM(FAILMSG) ERASE FREEKB NOHANDLE        00661002
         EXEC CICS RETURN                                               00662002
CONVERT  DS    0H                                                       00663002
         CVD   R1,WS_CVD                    convert bin to packed       00664002
         UNPK  WS_WORK(16),WS_CVD           unpack                      00665002
         OI    WS_WORK+15,X'F0'             remove sign                 00666002
         BR    R7                           and return                  00667002
*                                                                       00668002
*OVEIT   MVC   MSGPROG(0),5(INPUTREG)       set program name            00690002
ACTIVE   DC    CL8'ACTIVE'                                              00691002
INACTIVE DC    CL8'INACTIVE'                                            00692002
FAILMSG  DC CL75'Error issuing the inquire command.'                    00700002
OUTTXT   DS   0C                                                        00710002
         DC   C'               CICS System Status Inquiry'              00720002
         DC   X'1515'                                                   00730002
         DC   C'CICS Jobname               '                            00731002
OUTJOB   DS   CL8                                                       00731102
         DC   X'15'                                                     00731202
         DC   C'Current DSA Below          '                            00732002
OUTDSA   DS   CL9                                                       00732102
         DC   X'15'                                                     00732202
         DC   C'Current CDSA Size          '                            00733002
OUTCDSA  DS   CL9                                                       00733102
         DC   X'15'                                                     00733202
         DC   C'Current UDSA Size          '                            00734002
OUTUDSA  DS   CL9                                                       00734102
         DC   X'15'                                                     00734202
         DC   C'Current RDSA Size          '                            00735002
OUTRDSA  DS   CL9                                                       00735102
         DC   X'15'                                                     00735202
         DC   C'Current SDSA Size          '                            00736002
OUTSDSA  DS   CL9                                                       00736102
         DC   X'15'                                                     00736202
         DC   C'Current DSA Above          '                            00736302
OUTEDSA  DS   CL9                                                       00736402
         DC   X'15'                                                     00736502
         DC   C'Current ECDSA Size         '                            00736602
OUTECDSA DS   CL9                                                       00736702
         DC   X'15'                                                     00736802
         DC   C'Current EUDSA Size         '                            00736902
OUTEUDSA DS   CL9                                                       00737002
         DC   X'15'                                                     00737102
         DC   C'Current ERDSA Size         '                            00737202
OUTERDSA DS   CL9                                                       00737302
         DC   X'15'                                                     00737402
         DC   C'Current ESDSA Size         '                            00737502
OUTESDSA DS   CL9                                                       00737602
         DC   X'15'                                                     00737702
         DC   C'Re-enterent Program'                                    00737802
         DC   X'15'                                                     00737902
         DC   C'             Protection is '                            00738002
OUTRENT  DS   CL8                                                       00738102
         DC   X'15'                                                     00738202
         DC   C'Storage Protection is      '                            00738302
OUTSTOR  DS   CL8                                                       00738402
         DC   X'15'                                                     00738502
         DC   C'Transaction Isolation is   '                            00738602
OUTISO   DS   CL8                                                       00738702
         DC   X'15'                                                     00738802
         DC   C'CICS Startup was           '                            00738902
OUTSTART DS   CL9                                                       00739002
         DC   X'15'                                                     00739102
ENDTXT   DS   0C                                                        00739202
TXTLEN   DC   AL2(ENDTXT-OUTTXT)                                        00740002
*                                                                       00742001
         END                                                            00750000
