DCL DD SYSPTRS CHAR(16) BDRY(16);
    DCL SYSPTR .SETSPPFA DEF(SYSPTRS) POS(1);

DCL SPCPTR .ARG1 INIT(SPACE-PTR);
DCL DD SPACE-PTR CHAR(16) BDRY(16);
    DCL SPCPTR .SPCPTR DEF(SPACE-PTR) POS(1);

DCL SPCPTR .ARG2 INIT(ADDR-PTR);
DCL DD ADDR-PTR CHAR(16) BDRY(16);
    DCL SPCPTR .ADDR-PTR           DEF(ADDR-PTR) POS( 1);
    DCL DD ADDR-ADDRESS     BIN(4) DEF(ADDR-PTR) POS(13); /* REDEFS */
    DCL DD ADDR-SEGMENT    CHAR(5) DEF(ADDR-PTR) POS( 9);
    DCL DD ADDR-OFFSET     CHAR(3) DEF(ADDR-PTR) POS(14);

DCL OL SETSPPFA(.ARG1, .ARG2) ARG;

DCL DD RESOLVE CHAR(34);
    DCL DD RESOLVE-TYPE CHAR( 2) DEF(RESOLVE) POS( 1) INIT(X'0201');
    DCL DD RESOLVE-NAME CHAR(30) DEF(RESOLVE) POS( 3);
    DCL DD RESOLVE-AUTH CHAR( 2) DEF(RESOLVE) POS(33) INIT(X'0000');

DCL SYSPTR .SEPT(6440) BAS(@SEPT);

DCL DD PCO CHAR(256) BASPCO;
   DCL SPCPTR @SEPT   DEF(PCO) POS(  1);
   DCL SPCPTR @QTEMP  DEF(PCO) POS( 65);
   DCL SPCPTR @USRPRF DEF(PCO) POS(113);

DCL DD PCO-POINTER CHAR(16) BDRY(16);
    DCL SPCPTR .PCO DEF(PCO-POINTER) POS( 1);

DCL SPCPTR .REQUEST INIT(REQUEST);
DCL DD REQUEST CHAR(272);
    DCL DD REQ-TYPE    BIN(4)  DEF(REQUEST) POS( 1) INIT(3); /*USER */
    DCL DD REQ-DBCS    BIN(4)  DEF(REQUEST) POS( 5) INIT(0); /*NONE */
    DCL DD *           BIN(4)  DEF(REQUEST) POS( 9) INIT(0);
    DCL DD REQ-TSIZE   BIN(4)  DEF(REQUEST) POS(13) INIT(256);
    DCL DD REQ-TABLE(16) CHAR(16) DEF(REQUEST) POS(17) INIT
          (X'000102030405060708090A0B0C0D0E0F',
           X'101112131415161718191A1B1C1D1E1F',
           X'202122232425262728292A2B2C2D2E2F',
           X'303132333435363738393A3B3C3D3E3F',
           X'404142434445464748494A4B4C4D4E4F',
           X'505152535455565758595A5B5C5D5E5F',
           X'606162636465666768696A6B6C6D6E6F',
           X'707172737475767778797A7B7C7D7E7F',
           X'808182838485868788898A8B8C8D8E8F',
           X'909192939495969798999A9B9C9D9E9F',
           X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF',
           X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF',
           X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF',
           X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF',
           X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF',
           X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF');

DCL SPCPTR .LENGTH INIT(LENGTH);
DCL DD      LENGTH BIN(4);
DCL SPCPTR .DATA   INIT(DATA);
DCL DD      DATA   CHAR(1024);
DCL SPCPTR .ERROR  INIT(ERROR);
DCL DD      ERROR  BIN(4) INIT(0);

DCL OL GET-DATA (.REQUEST, .SPCPTR, .DATA, .LENGTH, .ERROR) ARG;
DCL OL PUT-DATA (.REQUEST, .DATA, .SPCPTR, .LENGTH, .ERROR) ARG;

DCL SPCPTR .PROGRAM INIT(PROGRAM);
DCL DD      PROGRAM CHAR(77) BDRY(16);
    DCL DD  PGM-BYTES-PRV      BIN(4) DEF(PROGRAM) POS( 1) INIT(77);
    DCL DD  PGM-LIB-TYPE     CHAR(02) DEF(PROGRAM) POS(10);
    DCL DD  PGM-LIB-NAME     CHAR(30) DEF(PROGRAM) POS(12);

DCL SPCPTR .THE-STACK;
DCL DD      THE-STACK CHAR(8) AUTO  BDRY(16);
    DCL DD  STK-BYTES-PRV      BIN(4) DEF(THE-STACK) POS( 1);
    DCL DD  STK-BYTES-AVL      BIN(4) DEF(THE-STACK) POS( 5);
    DCL DD  STK-NBR-OF-ENTRIES BIN(4) DEF(THE-STACK) POS( 9);
    DCL DD  STK-ENTRY(1)    CHAR(128) DEF(THE-STACK) POS(17);

DCL DD THE-ENTRY CHAR(128) BDRY(16);
    DCL SYSPTR .THE-ENTRY-PGM DEF(THE-ENTRY) POS(33);

DCL SYSPTR .OWN-LIB;
DCL DD OWN-USER-ID CHAR(10);

DCL SPCPTR .PARM1 PARM;
DCL DD PARM-ACTION CHAR(10) BAS(.PARM1);

DCL OL PARAMETERS (.PARM1) PARM EXT MIN(0);
DCL DD NBR-PARMS BIN(2);

/*******************************************************************/

ENTRY * (PARAMETERS) EXT;
    CPYNV      STK-BYTES-PRV, 8; /* MINIMUM */
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;
    MODASA    .THE-STACK, STK-BYTES-AVL;

    CPYNV      STK-BYTES-PRV, STK-BYTES-AVL;
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;

    OVRPGATR   1, 2; /* DO NOT CONSTRAIN ARRAY REFS */
    CPYBWP     THE-ENTRY, STK-ENTRY(STK-NBR-OF-ENTRIES);
    MATPTR    .PROGRAM, .THE-ENTRY-PGM; /* MYSELF */
    CPYBLA     RESOLVE-TYPE, PGM-LIB-TYPE;
    CPYBLA     RESOLVE-NAME, PGM-LIB-NAME;
    RSLVSP    .OWN-LIB, RESOLVE, *, *;

RESOLVE-PGMS:
    CPYBLA     RESOLVE-TYPE, X'0201';
    CPYBLAP    RESOLVE-NAME, "SETSPPFA" , " ";
    RSLVSP    .SETSPPFA, RESOLVE, .OWN-LIB, *;

    SETSPP    .PCO, PCO;
    STPLLEN    NBR-PARMS;
    CPYNV      LENGTH, 1024;

GET-OWN-USER-ID:
    CPYBLA     ADDR-PTR, PCO-POINTER;
    CPYBREP    ADDR-OFFSET, X'00';
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBWP     ADDR-PTR, @USRPRF;
    CPYBREP    ADDR-OFFSET, X'00';
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;
    CPYBLA     OWN-USER-ID, DATA(37:10);

GET-SUBSYSTEM:
    CPYBLA     ADDR-PTR, PCO-POINTER;
    CPYBREP    ADDR-OFFSET, X'00';
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBLA     ADDR-PTR, DATA(561:16); /* 210H SUBSYS  */
    CPYBREP    ADDR-OFFSET, X'00';
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBLA     ADDR-PTR, DATA(689:16); /* 2B0H UFCB    */
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBLA     ADDR-OFFSET, X'000120';
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBLA     ADDR-PTR, DATA(1:16);   /* XXXXH BUFFER */
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CMPNV(B)   NBR-PARMS, 0/EQ(SHOW-USER-INFO);
    CMPBLAP(B) PARM-ACTION, "*ERASE", " "/EQ(ERASE-USER-INFO);
    CMPBLAP(B) PARM-ACTION, "*ANY",   " "/EQ(ERASE-ANY-INFO);
    CMPBLAP(B) PARM-ACTION, "*SHOW" , " "/EQ(SHOW-USER-INFO);

SHOW-USER-INFO:
    CMPBLA(B)  DATA(1:1), "0"/LO(SHOW-USER-PASSWORD);

    CPYBLAP    MSG-TEXT, "Please have somebody Sign on...", " ";
    CALLI      SHOW-MESSAGE, *, .SHOW-MESSAGE;
    B          RETURN;

SHOW-USER-PASSWORD:
    CPYBLAP    MSG-TEXT, DATA(1:20), " ";
    CALLI      SHOW-MESSAGE, *, .SHOW-MESSAGE;
    B          RETURN;

ERASE-USER-INFO:
    CMPBLA(B)  DATA(1:10), OWN-USER-ID/NEQ(RETURN);

ERASE-ANY-INFO:
    CPYBREP    DATA(1:20), " ";
    CPYNV      LENGTH, 20;
    CALLI      PUT-DATA-AT-POINTER, *, .PUT-DATA-AT-POINTER;
RETURN:
    DEACTPG    *;
    RTX        *;

DCL INSPTR .GET-DATA-AT-POINTER;
ENTRY       GET-DATA-AT-POINTER INT;
    CALLX     .SETSPPFA, SETSPPFA, *;
    CALLX     .SEPT(5063), GET-DATA, *;
    B         .GET-DATA-AT-POINTER;

DCL INSPTR .PUT-DATA-AT-POINTER;
ENTRY       PUT-DATA-AT-POINTER INT;
    CALLX     .SETSPPFA, SETSPPFA, *;
    CALLX     .SEPT(5063), PUT-DATA, *;
    B         .PUT-DATA-AT-POINTER;

/************************ SHOW A MESSAGE ***************************/

DCL SPCPTR .MSG-ID   INIT(MSG-ID);
DCL DD      MSG-ID   CHAR (7) INIT("       ");

DCL SPCPTR .MSG-FILE INIT(MSG-FILE);
DCL DD      MSG-FILE CHAR(20) INIT("                    ");

DCL SPCPTR .MSG-TEXT INIT(MSG-TEXT);
DCL DD      MSG-TEXT CHAR(70);

DCL SPCPTR .MSG-SIZE INIT(MSG-SIZE);
DCL DD      MSG-SIZE BIN( 4)  INIT(70);

DCL SPCPTR .MSG-TYPE INIT(MSG-TYPE);
DCL DD      MSG-TYPE CHAR(10) INIT("*INFO     ");

DCL SPCPTR .MSG-QS   INIT(MSG-QS);
DCL DD      MSG-QS   CHAR(20) INIT("*REQUESTER          ");

DCL SPCPTR .MSG-QSN  INIT(MSG-QSN);
DCL DD      MSG-QSN  BIN( 4)  INIT(1);

DCL SPCPTR .REPLY-Q  INIT(REPLY-Q);
DCL DD      REPLY-Q  CHAR(20) INIT("                    ");

DCL SPCPTR .MSG-KEY  INIT(MSG-KEY);
DCL DD      MSG-KEY  CHAR( 4);

DCL SPCPTR .ERR-CODE INIT(ERR-CODE);
DCL DD      ERR-CODE BIN( 4) INIT(0);

DCL OL QMHSNDM (.MSG-ID,   .MSG-FILE, .MSG-TEXT, .MSG-SIZE,
                .MSG-TYPE, .MSG-QS,   .MSG-QSN,  .REPLY-Q,
                .MSG-KEY,  .ERR-CODE)  ARG;

DCL INSPTR .SHOW-MESSAGE;
ENTRY       SHOW-MESSAGE INT;
    CALLX     .SEPT(4268), QMHSNDM, *; /* SEND MSG TO MSGQ */
    B         .SHOW-MESSAGE;

PEND;