         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
$INCLUDE INCLCAP     ;                                         << 2414>>02168000
   GROUPNAMEMISS   = 541,  << Group name missing >>            << 2414>>02356000
   GRPNAMETOOLONG  = 542,  <<group name > 8 chars long >>      << 2414>>02356400
   GRPEMBSPEC      = 544,  <<Gname contain nonalphanumeric>>   << 2414>>02356500
   ACCTNAMEMISS    = 551,  << Account name missing >>          << 2414>>02356600
   ACCTEMBSPEC     = 554,  <<aname contain non alphanumeric>>  << 2414>>02357000
   USERNAMETOOLONG = 592,  << user name > 8 chars long >>      << 2414>>02358000
   USERNAMEMISS    = 591,  << User name missing  >>            << 2414>>02358200
   USEREMBSPEC     = 594,  <<non alphanumeric char in uname>>  << 2414>>02359000
   NONEXISTACCT    = 909,  << NON EXISTENT ACCOUNT >>          << 2414>>02936000
   DEALLOCAPERR    = 1659, <<DEALLO ALLOCATED FILE NEED OP>>   << 1939>>03187000
   PVMVTABXF= 4:4 #,                   <<PVINFO FIELD>>        <<O2170>>04200000
   PV'USED = ABSOLUTE(%1365).(12:1)#; <<PV USAGE BIT>>         <<O2170>>04201000
   INTEGER PROCEDURE ADDJTENTRY(N1,N2,N3,N4,TNO,SIZE,INFO);    << 9773>>05655000
   BYTE ARRAY N1,N2,N3,N4;                                     << 9773>>05670000
$EDIT VOID=05687500                                            << 9773>>05687500
   INTEGER PROCEDURE XADDJTENTRY(N1,N2,N3,N4,TNO,SIZE,INFO,    << 9773>>05690000
                                 XN1,XN2,XN3,XN4);             << 9773>>05692500
   BYTE ARRAY N1,N2,N3,N4,XN1,XN2,XN3,XN4;                     << 9773>>05705000
   INTEGER PROCEDURE XREMJTENTRY(N1,N2,N3,N4,TNO);             << 9773>>05725000
   BYTE ARRAY N1,N2,N3,N4;                                     << 9773>>05740000
$EDIT                                                          << 1939>>05800000
INTEGER PROCEDURE ALLOCATEPROG (NAM,OPCAP);                    << 1939>>05801000
   VALUE OPCAP;                                                << 1939>>05802000
   LOGICAL OPCAP;                                              << 1939>>05803000
$EDIT                                                          << 1939>>05840000
INTEGER PROCEDURE DEALLOCATEPROG (NAM,OPCAP);                  << 1939>>05841000
   VALUE OPCAP;                                                << 1939>>05842000
   LOGICAL OPCAP;                                              << 1939>>05843000
                            VSCOMM, SPECMASK, CROSSACCT);      << 2414>>06360000
INTEGER ARRAY CROSSACCT;                                       << 2414>>06401000
INTEGER PROCEDURE FINDJTENTRY(N1,N2,N3,N4,TNO,A,JDT);          << 9773>>06595000
BYTE ARRAY N1,N2,N3,N4;                                        << 9773>>06610000
                                                                <<ds83>>06660250
INTEGER PROCEDURE AS'DSPLABEL(PLABEL'INDX);                     <<ds83>>06660500
VALUE PLABEL'INDX;                                              <<ds83>>06660750
INTEGER PLABEL'INDX;                                            <<ds83>>06661000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                          <<ds83>>06661250
                                                               << 9312>>06966000
INTEGER PROCEDURE GETDEVINFO(DEV'NAME,DEVINFO);                << 9312>>06967000
BYTE ARRAY DEV'NAME;                                           << 9312>>06968000
INTEGER ARRAY DEVINFO;                                         << 9312>>06969000
OPTION EXTERNAL;                                               << 9312>>06970000
PROCEDURE AUTODEALLOC'BY'NAME(FILESET);                        <<D1854>>06976000
  BYTE ARRAY FILESET;                                          <<D1854>>06977000
  OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                       <<D1854>>06978000
                                                               <<D1854>>06979000
     CXAPPCCONTROL,                                            <<A1988>>07056000
     CXAPPCCONTROL:                                            <<A1988>>07166000
      MOVE SUBPARSER := "CXAPPCCONTROL' ";                     <<A1988>>07167000
      GO TO STARTUP;                                           <<A1988>>07168000
                                                               <<A1988>>07169000
  CXNFT'PLABEL=  6,                                             <<ds83>>07532500
<< CALL ONENET (CXNFT) IF IT IS ON THE SYSTEM >>                <<ds83>>07540250
                                                                <<ds83>>07540500
TOS := @PARMSP;                                                 <<ds83>>07540750
TOS := @ERRNUM;                                                 <<ds83>>07541000
TOS := @PARMNUM;                                                <<ds83>>07541250
TOS := AS'DSPLABEL(CXNFT'PLABEL);                               <<ds83>>07541500
IF S0 <> 0 THEN                                                 <<ds83>>07541750
   BEGIN                                                        <<ds83>>07542000
   ASSEMBLE(PCAL 0);                                            <<ds83>>07542250
   RETURN;                                                      <<ds83>>07542500
   END;                                                         <<ds83>>07542750
ASSEMBLE(SUBS 4);                                               <<ds83>>07543000
                                                                <<ds83>>07543250
                                                                <<ds83>>07860000
   << NOTE: CXDSLINED and CXREMOTED are now independent   >>    <<ds83>>07865000
   << procedures, defined below.                          >>    <<ds83>>07870000
  << former CXDSLINED entry point >>                            <<ds83>>07885000
  << form CXREMOTED entry pointer >>                            <<ds83>>07895000
                                                                <<ds83>>07960250
                                                                <<ds83>>07960275
PROCEDURE CXDSLINED EXECUTORHEAD;                               <<ds83>>07960300
   OPTION PRIVILEGED, UNCALLABLE;                               <<ds83>>07960325
                                                                <<ds83>>07960350
   << CXDSLINED is called by the CI to select the executor >>   <<ds83>>07960375
   << for the optional :DSLINE command.  If the OneNet Ap- >>   <<ds83>>07960400
   << plication Services product is installed on the system>>   <<ds83>>07960425
   << the CXDSLINE2 procedure will be used; its plabel is  >>   <<ds83>>07960450
   << is stored in the OneNet Plabel Table.  If Application>>   <<ds83>>07960475
   << Services is not installed, but the DS1 product is,   >>   <<ds83>>07960500
   << the CXDSLINE procedure will be used (as in the past);>>   <<ds83>>07960525
   << its plabel is held in SYSGLOB cell %343.  If neither >>   <<ds83>>07960550
   << OneNet nor DS1 is present, the DS NOT FOUND error    >>   <<ds83>>07960575
   << will be reported.                                    >>   <<ds83>>07960600
                                                                <<ds83>>07960625
BEGIN                                                           <<ds83>>07960650
   INTEGER PLABEL;  <<plabel of CXDSLINE2 or CXDSLINE procedur  <<ds83>>07960675
   EQUATE                                                       <<ds83>>07960700
      CXDSLINE2PLABEL=   21, <<Plabel Table index of CXDSLINE2  <<ds83>>07960725
      CXDSLINEPLABEL =%1343; <<abs address of CXDSLINE plabel   <<ds83>>07960750
                                                                <<ds83>>07960775
   PLABEL := AS'DSPLABEL( CXDSLINE2PLABEL );                    <<ds83>>07960800
   IF PLABEL = 0 THEN                                           <<ds83>>07960825
      PLABEL := ABSOLUTE( CXDSLINEPLABEL  );                    <<ds83>>07960850
   IF PLABEL <> 0 THEN                                          <<ds83>>07960875
      BEGIN                                                     <<ds83>>07960900
      TOS := @PARMSP;                                           <<ds83>>07960925
      TOS := @ERRNUM;                                           <<ds83>>07960950
      TOS := @PARMNUM;                                          <<ds83>>07960975
      TOS := PLABEL;                                            <<ds83>>07960977
      ASSEMBLE( PCAL 0 );                                       <<ds83>>07961000
      END                                                       <<ds83>>07961025
   ELSE                                                         <<ds83>>07961050
      CIERR( ERRNUM := DSSUBSNOTFOUND );                        <<ds83>>07961075
END;  <<CXDSLINED>>                                             <<ds83>>07961100
                                                                <<ds83>>07961125
                                                                <<ds83>>07961150
PROCEDURE CXREMOTED EXECUTORHEAD;                               <<ds83>>07961175
   OPTION PRIVILEGED, UNCALLABLE;                               <<ds83>>07961200
                                                                <<ds83>>07961225
   << CXREMOTED is called by the CI to select the executor >>   <<ds83>>07961250
   << for the optional :REMOTE command.  If the OneNet Ap- >>   <<ds83>>07961275
   << plication Services product is installed on the system>>   <<ds83>>07961300
   << the CXREMOTE2 procedure will be used; its plabel is  >>   <<ds83>>07961325
   << is stored in the OneNet Plabel Table.  If Application>>   <<ds83>>07961350
   << Services is not installed, but the DS1 product is,   >>   <<ds83>>07961375
   << the CXREMOTE procedure will be used (as in the past);>>   <<ds83>>07961400
   << its plabel is held in SYSGLOB cell %342.  If neither >>   <<ds83>>07961425
   << OneNet nor DS1 is present, the DS NOT FOUND error    >>   <<ds83>>07961450
   << will be reported.                                    >>   <<ds83>>07961475
                                                                <<ds83>>07961500
BEGIN                                                           <<ds83>>07961525
   INTEGER PLABEL;  <<plabel of CXREMOTE2 or CXREMOTE procedur  <<ds83>>07961550
   EQUATE                                                       <<ds83>>07961575
      CXREMOTE2PLABEL=   22, <<Plabel Table index of CXREMOTE2  <<ds83>>07961600
      CXREMOTEPLABEL =%1342; <<abs address of CXREMOTE plabel   <<ds83>>07961625
                                                                <<ds83>>07961650
   PLABEL := AS'DSPLABEL( CXREMOTE2PLABEL );                    <<ds83>>07961675
   IF PLABEL = 0 THEN                                           <<ds83>>07961700
      PLABEL := ABSOLUTE( CXREMOTEPLABEL  );                    <<ds83>>07961725
   IF PLABEL <> 0 THEN                                          <<ds83>>07961750
      BEGIN                                                     <<ds83>>07961775
      TOS := @PARMSP;                                           <<ds83>>07961800
      TOS := @ERRNUM;                                           <<ds83>>07961825
      TOS := @PARMNUM;                                          <<ds83>>07961850
      TOS := PLABEL;                                            <<ds83>>07961852
      ASSEMBLE( PCAL 0 );                                       <<ds83>>07961875
      END                                                       <<ds83>>07961900
   ELSE                                                         <<ds83>>07961925
      CIERR( ERRNUM := DSSUBSNOTFOUND );                        <<ds83>>07961950
END;  <<CXREMOTED>>                                             <<ds83>>07961975
                                                                <<ds83>>07962000
                                                                <<ds83>>07962025
PROCEDURE CXNSCONTROLD EXECUTORHEAD;                            <<ds83>>07962050
   OPTION PRIVILEGED, UNCALLABLE;                               <<ds83>>07962075
                                                                <<ds83>>07962100
   << CXNSCONTROLD is called by the CI to select the exe-  >>   <<ds83>>07962125
   << cutor for the optional :NSCONTROL command.  If the   >>   <<ds83>>07962150
   << OneNet Application Services product is installed on  >>   <<ds83>>07962175
   << the system, the CXNSCONTROL procedure will be used;  >>   <<ds83>>07962200
   << its plabel is stored in the OneNet Plabel Table.  If >>   <<ds83>>07962225
   << OneNet is not on the system, the DS NOT FOUND error  >>   <<ds83>>07962250
   << will be reported.  Note that there is no :NSCONTROL  >>   <<ds83>>07962275
   << command in the DS1 product, so it is not involved    >>   <<ds83>>07962300
   << here.                                                >>   <<ds83>>07962325
                                                                <<ds83>>07962375
BEGIN                                                           <<ds83>>07962400
   INTEGER PLABEL;  <<plabel of CXNSCONTROL procedure >>        <<ds83>>07962425
   EQUATE                                                       <<ds83>>07962450
      CXNSCONTROLPLABEL= 23; <<Plabel Table index of CXNSCONTR  <<ds83>>07962475
                                                                <<ds83>>07962525
   PLABEL := AS'DSPLABEL( CXNSCONTROLPLABEL );                  <<ds83>>07962550
   IF PLABEL <> 0 THEN                                          <<ds83>>07962625
      BEGIN                                                     <<ds83>>07962650
      TOS := @PARMSP;                                           <<ds83>>07962675
      TOS := @ERRNUM;                                           <<ds83>>07962700
      TOS := @PARMNUM;                                          <<ds83>>07962725
      TOS := PLABEL;                                            <<ds83>>07962727
      ASSEMBLE( PCAL 0 );                                       <<ds83>>07962750
      END                                                       <<ds83>>07962775
   ELSE                                                         <<ds83>>07962800
      CIERR( ERRNUM := DSSUBSNOTFOUND );                        <<ds83>>07962825
END;  <<CXNSCONTROLD>>                                          <<ds83>>07962850
                                                                <<ds83>>07962875
    T1 := XADDJTENTRY(FORMDES,N1,N2,N1,-4,T1,WFENTRY,          << 9773>>09355000
                      BACKREFNAME,N1,N2,N1);                   << 9773>>09360000
     TOS := ADDJTENTRY(FORMDES,N1,N2,N1,-4,LOC,WFENTRY);       << 9773>>12305000
          SEGSIZE =   8000,            <<DATA-SEG SIZE>>       << 2132>>12830000
        "HP7933/ ",                                            <<01037>>14370000
        "HP7936  ",                                            <<01037>>14371000
        "HP7937  ",                                            <<02350>>14372000
        "HP7957  ",                                                     14372100
        "HP7958  ";                                                     14372200
$EDIT                                                          << 2414>>16355000
LOGICAL ARRAY FEQ'ENTRY(0:17);                                 << 9312>>18115200
BYTE ARRAY B'ENTRY(*)=FEQ'ENTRY;                               << 9312>>18115300
BYTE ARRAY DEV'NAME(0:7);                                      << 9312>>18115400
INTEGER ARRAY DEVINFO(0:12);                                   << 9312>>18115500
INTEGER ENTRY'SIZE;                                            << 9312>>18115600
EQUATE NODEVICETAPE = 664,                                     << 9312>>18115700
       JDTFULL = 656;                                          << 9312>>18115800
         THEN XREMJTENTRY(LHS,BLANK,BLANK,BLANK,3);             << ADS >18140000
      XREMJTENTRY(LHS,BLANK,BLANK,BLANK,3)                     << 9773>>18155000
                                                               << 9312>>18160100
LOGICAL SUBROUTINE IMPLICIT'FILE'EQ;                           << 9312>>18160200
<< this subroutine attempts to do an implicit file equation >> << 9312>>18160300
<< for file DUMPTAPE. If device TAPE is present, then the   >> << 9312>>18160400
<< file is tape file; If not, it tries CTAPE. Else return   >> << 9312>>18160500
BEGIN                                                          << 9312>>18161100
IMPLICIT'FILE'EQ := FALSE;                                     << 9312>>18161200
FEQ'ENTRY := 0;                                                << 9312>>18161300
MOVE FEQ'ENTRY(1) := FEQ'ENTRY, (17);                          << 9312>>18161400
MOVE DEV'NAME := "TAPE    ";                                   << 9312>>18161500
IF (GETDEVINFO(DEV'NAME,DEVINFO)) = 0 THEN                     << 9312>>18161600
   BEGIN                                                       << 9312>>18161700
   FEQ'ENTRY(2).(8:8) := 4;                                    << 9312>>18161800
   MOVE B'ENTRY(6):= "TAPE";                                   << 9312>>18161900
   FEQ'ENTRY(7).(15:1) := 1;                                   << 9312>>18162000
   ENTRY'SIZE := 17;                                           << 9312>>18162100
   GOTO ADD'ENTRY;                                             << 9312>>18162200
   END;                                                        << 9312>>18162300
MOVE DEV'NAME := "CTAPE   ";                                   << 9312>>18162400
IF (GETDEVINFO(DEV'NAME,DEVINFO)) = 0 THEN                     << 9312>>18162500
   BEGIN                                                       << 9312>>18162600
   FEQ'ENTRY(2).(8:8) := 5;                                    << 9312>>18162700
   MOVE B'ENTRY(6):= "CTAPE";                                  << 9312>>18162800
   FEQ'ENTRY(8).(15:1) := 1;                                   << 9312>>18162900
   ENTRY'SIZE := 18;                                           << 9312>>18163000
   GOTO ADD'ENTRY;                                             << 9312>>18163100
   END;                                                        << 9312>>18163200
                                                               << 9312>>18163300
CIERR (ERRNUM:=NODEVICETAPE);                                  << 9312>>18163400
RETURN;                                                        << 9312>>18163500
                                                               << 9312>>18163600
ADD'ENTRY:                                                     << 9312>>18163700
  FEQ'ENTRY.(14:1) := 1;  << pmask: DEV= parm present >>       << 9312>>18163800
  MOVE TEMPBUFF := "DUMPTAPE ";                                << 9312>>18163810
  IF (ADDJTENTRY(TEMPBUFF,BLANK,BLANK,BLANK,                   << 9773>>18163900
                 -3,ENTRY'SIZE,FEQ'ENTRY)) <> 0 THEN           << 9773>>18163910
     CIERR(ERRNUM:=JDTFULL);                                   << 9773>>18164000
  IMPLICIT'FILE'EQ := TRUE;                                    << 9312>>18164100
                                                                        18164300
END;    << implicit'file'eq subroutine >>                      << 9312>>18164400
                                                               << 9312>>18164500
        CNT := FINDJTENTRY(TEMPBUFF,BLANK,BLANK,BLANK,3,A,D1); << 9773>>18285000
           << do an implicit one for them. It will be either >><< 9312>>18320000
           << FILE DUMPTAPE;DEV=TAPE or DEV=CTAPE if device  >><< 9312>>18325000
           << TAPE is not configured. If neither are there,  >><< 9312>>18330000
           << we just have to quit                           >><< 9312>>18335000
                                                               << 9312>>18340000
           IF NOT IMPLICIT'FILE'EQ THEN                        << 9312>>18345000
              RETURN;                                          << 9312>>18350000
   IF NUMPARMS > 0 THEN    << if user specified dumpfile >>    << 9302>>18532000
      BEGIN                << and it's not $NULL         >>    << 9302>>18533000
      @FNAME := LPARM;                                         << 9302>>18534000
      IF FNAME <> "$NULL" THEN CHECK'FOR'JOBS;                 << 9302>>18535000
      END             << then check for other running jobs >>  << 9302>>18536000
   ELSE               << no dumpfile specified, check too  >>  << 9302>>18537000
      CHECK'FOR'JOBS;                                          << 9302>>18538000
   CREATE(LHS,ENTRYNAME,PIN,,1);                                        18555000
$EDIT                                                          << 2414>>18722000
       ARRAY QARRAY (*) = Q + 0;                               << 1939>>18766000
       INTEGER PCBGLOBLOC;                                     << 1939>>18767000
       POINTER UCAPPTR;                                        << 1939>>18768000
INTEGER   S0 = S-0;                                            << 1939>>18769000
      LOGICAL HASOP := FALSE;                                  << 1939>>18772000
          PXGLOBAL;                                            << 1939>>19082000
           @UCAPPTR := @PXG'USERATTRIBUTES;                    << 1939>>19083000
$EDIT                                                          << 1939>>19085000
         IF UCAPOP =1 THEN HASOP:=TRUE                         << 1939>>19086000
            ELSE  HASOP:=FALSE;                                << 1939>>19086100
          TOS := IF DEALOC THEN DEALLOCATEPROG (PNAME,HASOP)   << 1939>>19087000
$EDIT                                                          << 1939>>19090000
                           ELSE ALLOCATEPROG (PNAME,HASOP);    << 1939>>19092000
            ELSE IF S0=DEALLOCAPERR THEN                       << 1939>>19127000
                        CIERR (ERRNUM:=DEALLOCAPERR)           << 1939>>19128000
EQUATE                                                         << 2284>>19695100
       BUF0X       = %1172,  <<BUFFER 0 DST NR.>>              << 2284>>19695200
       BUFSIZEX    = %1174,  <<BUFFER SIZE (SECTORS)>>         << 2284>>19695300
       FREEX       = %1175,  <<FREE PTR IN CUR. DST >>         << 2284>>19695400
       FLAGX       = SYSDB+%176,  <<FLAG WORD>>                << 2284>>19695500
       EMPTY=0,CURRENT=1,FULL=2;                               << 2284>>19695600
INTEGER FREEP,                                                 << 2284>>19695700
        DSTX,                                                  << 2284>>19695800
        BSIZE,                                                 << 2284>>19695900
        FILLED'BUFF;                                           << 2284>>19696000
DEFINE STATE = (0:2)#;                                         << 2284>>19696100
   << first get the current DST and free'pointer,         >>   << 2284>>19790100
   FREEP := ABSOLUTE (FREEX);                                  << 2284>>19790200
   DSTX := ABSOLUTE (FLAGX).(13:1); << curr dst >>             << 2284>>19790300
   BSIZE := ABSOLUTE (BUFSIZEX) & LSL(7);                      << 2284>>19790400
   FILLED'BUFF := FREEP/BSIZE;  << number of filled bufs >>    << 2284>>19790500
   << save DSTX and filled buf in FLAGX, to signal LOG >>      << 2284>>19790600
   << process to open a new log file  at this point >>         << 2284>>19790700
   ABSOLUTE (FLAGX).(0:1) := DSTX;                             << 2284>>19790800
   << if Free pointer is not at the beginning of a buf, >>     << 2284>>19790900
   << advance FREEX to next buf, or if last buf, next DST >>   << 2284>>19791000
   IF FREEP MOD BSIZE <> 0  << in middle of a buf >>           << 2284>>19791100
      THEN                                                     << 2284>>19791200
      BEGIN                                                    << 2284>>19791300
      FILLED'BUFF := FILLED'BUFF + 1; << partially filled >>   << 2284>>19791400
      IF FILLED'BUFF < 8 THEN  << move freex to next one >>    << 2284>>19791500
         ABSOLUTE (FREEX) := FILLED'BUFF * BSIZE               << 2284>>19791600
      ELSE                                                     << 2284>>19791700
         BEGIN << end of DST, must mark as FULL and switch >>  << 2284>>19791800
         ABSOLUTE (BUF0X+DSTX).STATE := FULL;                  << 2284>>19791900
         DSTX := (DSTX+1).(15:1);                              << 2284>>19792000
         IF ABSOLUTE (BUF0X+DSTX).STATE = EMPTY THEN           << 2284>>19792100
            BEGIN  << make it the current one >>               << 2284>>19792200
            ABSOLUTE (X).STATE := CURRENT;                     << 2284>>19792300
            ABSOLUTE (FLAGX).(13:1) := DSTX;                   << 2284>>19792400
            ABSOLUTE (X:=X-1) := 0; << reset FREEX >>          << 2284>>19792500
            END;                                               << 2284>>19792600
         END;                                                  << 2284>>19792700
      END;  << in middle of buf >>                             << 2284>>19792800
   ABSOLUTE (FLAGX).(1:4) := FILLED'BUFF;                      << 2284>>19792900
$CONTROL SEGMENT=CIORGMAN                                      << 2414>>20401000
LOGICAL PROCEDURE DECODENAME(PARMPTR, NEWPART, ACCTPART,       << 2414>>20401300
   TOTALLEN, ERRNUM, EVENTTYPE);                               << 2414>>20401400
VALUE TOTALLEN, EVENTTYPE;                                     << 2414>>20401500
BYTE ARRAY PARMPTR, NEWPART, ACCTPART;                         << 2414>>20401600
INTEGER TOTALLEN, ERRNUM, EVENTTYPE;                           << 2414>>20401800
OPTION PRIVILEGED, UNCALLABLE;                                 << 2414>>20401900
BEGIN                                                          << 2414>>20402000
<<*******************************************************>>    << 2414>>20402100
<< Purpose of this procedure is to decode the user/group >>    << 2414>>20402200
<< and account name that is combined in PARMPTR, the     >>    << 2414>>20402300
<< separator bt. the two is a period.  Leading & trailing>>    << 2414>>20402400
<< blank will all be taken care of.  PARMPTR is a pointer>>    << 2414>>20402500
<< to the name image buffer.  ACCTPART will return blanks>>    << 2414>>20402600
<< if acct name not provided.  EVENTTYPE 1=group, 3=user  >>   << 2414>>20402700
<< First portion of the name can't be blank(s).  The two >>    << 2414>>20402800
<< special characters allowed in PARMPTR are "." and " " >>    << 2414>>20402900
<< The string will be terminated by a ";".               >>    << 2414>>20403000
<< At this point, only PURGEGROUP, PURGEUSER, NEWGROUP   >>    << 2414>>20403100
<< NEWUSER, ALTUSER and ALTGROUP call this routine.      >>    << 2414>>20403200
<<*******************************************************>>    << 2414>>20403300
INTEGER TEMPLEN;                                               << 2414>>20403400
INTEGER NEWLEN := 0;                                           << 2414>>20403500
INTEGER ACCTLEN := 0;                                          << 2414>>20403600
DEFINE PERIOD = "."#;                                          << 2414>>20403700
BYTE ARRAY BTEMP(0:TOTALLEN);                                  << 2414>>20403800
   DECODENAME := FALSE;                                        << 2414>>20403900
   MOVE NEWPART := "        ";                                 << 2414>>20404000
   MOVE ACCTPART := "        ";                                << 2414>>20404100
   IF TOTALLEN = 0 THEN   << Don't allow blank user/grp name >><< 2414>>20404200
   BEGIN                                                       << 2414>>20404300
      IF EVENTTYPE = 3 THEN                                    << 2414>>20404310
         CIERR(ERRNUM := USERNAMEMISS, PARMPTR)                << 2414>>20404320
      ELSE CIERR(ERRNUM := GROUPNAMEMISS, PARMPTR);            << 2414>>20404330
      RETURN;                                                  << 2414>>20404500
   END;                                                        << 2414>>20404600
   MOVE BTEMP := PARMPTR, (TOTALLEN);                          << 2414>>20404700
   BTEMP(TOTALLEN) := ";";   << terminate char >>              << 2414>>20404800
   IF BTEMP <> ALPHA THEN  <<check 1st char of user/grp name>> << 2414>>20404900
   BEGIN                                                       << 2414>>20405000
       IF EVENTTYPE = 3 THEN                                   << 2414>>20405130
          CIERR(ERRNUM := USEREXPECTALPHA, PARMPTR)            << 2414>>20405140
       ELSE CIERR(ERRNUM := GRPEXPECTALPHA, PARMPTR);          << 2414>>20405150
       RETURN;                                                 << 2414>>20405200
   END;                                                        << 2414>>20405300
   <<Move until non ANS char is encountered or NEWPART>8 char>><< 2414>>20405400
   WHILE NEWLEN <= 8 AND                                       << 2414>>20405500
      (BTEMP(NEWLEN) = ALPHA OR BTEMP(NEWLEN) = NUMERIC) DO    << 2414>>20405600
   BEGIN                                                       << 2414>>20405700
      IF NEWLEN < 8 THEN NEWPART(NEWLEN) := BTEMP(NEWLEN);     << 2414>>20405800
      NEWLEN := NEWLEN + 1;                                    << 2414>>20405900
   END;                                                        << 2414>>20406000
   << 5 possible cases: User/Group name too long, ".", ";" >>  << 2414>>20406100
   << " ", or other special character(s)                   >>  << 2414>>20406110
   IF NEWLEN > 8 THEN           << more than 8 characters >>   << 2414>>20406150
   BEGIN                                                       << 2414>>20406200
       IF EVENTTYPE = 3 THEN                                   << 2414>>20406300
          CIERR(ERRNUM := USERNAMETOOLONG, PARMPTR)            << 2414>>20406320
       ELSE CIERR(ERRNUM := GRPNAMETOOLONG, PARMPTR);          << 2414>>20406330
      RETURN;                                                  << 2414>>20406400
   END;                                                        << 2414>>20406500
   IF BTEMP(NEWLEN) = ";" THEN                                 << 2414>>20406510
   BEGIN                                                       << 2414>>20406520
      DECODENAME := TRUE;                                      << 2414>>20406530
      RETURN;                                                  << 2414>>20406540
   END;                                                        << 2414>>20406550
   IF (BTEMP(NEWLEN) <> ".") AND (BTEMP(NEWLEN) <> " ")  THEN  << 2414>>20406700
   BEGIN  << special characters in user/group name >>          << 2414>>20406800
      IF EVENTTYPE = 3 THEN                                    << 2414>>20406900
          CIERR(ERRNUM := USEREMBSPEC, PARMPTR)                << 2414>>20407000
      ELSE CIERR(ERRNUM := GRPEMBSPEC, PARMPTR);               << 2414>>20407100
      RETURN;                                                  << 2414>>20407110
   END;                                                        << 2414>>20407120
   TEMPLEN := NEWLEN;     << Don't mess up NEWLEN's value >>   << 2414>>20407140
   << Take care of trailing blanks in the user/group name >>   << 2414>>20407160
   WHILE BTEMP(TEMPLEN) = " " DO TEMPLEN := TEMPLEN+1;         << 2414>>20407200
   IF BTEMP(TEMPLEN) = ";" THEN                                << 2414>>20407220
   BEGIN   << This is the case user type in trailing blanks >> << 2414>>20407230
      DECODENAME := TRUE;                                      << 2414>>20407240
      RETURN;                                                  << 2414>>20407250
   END;                                                        << 2414>>20407260
   << NOTE!!! from now on all CIERR refer to account part >>   << 2414>>20407300
   IF BTEMP(TEMPLEN) <> PERIOD THEN                            << 2414>>20407400
   BEGIN                                                       << 2414>>20407500
      IF EVENTTYPE=3 THEN CIERR(ERRNUM := USEREMBSPEC,PARMPTR) << 2414>>20407600
         ELSE CIERR(ERRNUM := GRPEMBSPEC, PARMPTR);            << 2414>>20407610
      RETURN;                                                  << 2414>>20407700
   END;                                                        << 2414>>20407800
   TEMPLEN := TEMPLEN+1;  << expect acct name after the "." >> << 2414>>20407900
   << chop off leading blanks in account name >>               << 2414>>20407920
   WHILE BTEMP(TEMPLEN) = " " DO TEMPLEN := TEMPLEN + 1;       << 2414>>20408000
   IF BTEMP(TEMPLEN) <> ALPHA THEN                             << 2414>>20408100
   BEGIN                                                       << 2414>>20408200
   << A period is embedded but no account name is enclosed  >> << 2414>>20408300
      IF BTEMP(TEMPLEN) = ";" THEN                             << 2414>>20408400
         CIERR(ERRNUM :=  ACCTNAMEMISS, PARMPTR)   <<blank>>   << 2414>>20408600
      ELSE CIERR(ERRNUM := ACCTEXPECTALPHA, PARMPTR);          << 2414>>20408700
      RETURN;                                                  << 2414>>20408800
   END;                                                        << 2414>>20408900
   << in case acct name is too long & mess up code or logic >> << 2414>>20409000
   WHILE ACCTLEN <= 8 AND                                      << 2414>>20409100
      (BTEMP(TEMPLEN) = ALPHA OR BTEMP(TEMPLEN) = NUMERIC) DO  << 2414>>20409200
      BEGIN                                                    << 2414>>20409300
        IF ACCTLEN < 8 THEN ACCTPART(ACCTLEN):=BTEMP(TEMPLEN); << 2414>>20409400
        TEMPLEN := TEMPLEN + 1;                                << 2414>>20409500
        ACCTLEN := ACCTLEN + 1;                                << 2414>>20409600
      END;                                                     << 2414>>20409700
   IF ACCTLEN > 8 THEN                                         << 2414>>20409800
   BEGIN                                                       << 2414>>20409900
      CIERR(ERRNUM := ACCTNAMETOOLONG,PARMPTR);                << 2414>>20410000
      RETURN;                                                  << 2414>>20410100
   END;                                                        << 2414>>20410200
   << case of trailing blanks with special chars enclose >>    << 2414>>20410300
   IF BTEMP(TEMPLEN) <> ";" THEN                               << 2414>>20410400
   << This relie on the fact that MYCOMMAND will terminate >>  << 2414>>20410500
   << when it encounter a ";" >>                               << 2414>>20410600
   BEGIN                                                       << 2414>>20410700
      CIERR(ERRNUM := ACCTEMBSPEC,PARMPTR);                    << 2414>>20410800
      RETURN;                                                  << 2414>>20410900
   END;                                                        << 2414>>20411000
   DECODENAME := TRUE;                                         << 2414>>20412000
END;       << end of DECODENAME >>                             << 2414>>20413000
                                                               << 2414>>20414000
                             VSCOMM, SPECMASK, CROSACCT);      << 2414>>20785000
INTEGER ARRAY CROSACCT;                                        << 2414>>20831000
BYTE ARRAY BCROSACCT(*) = CROSACCT;                            << 2414>>20872000
DEFINE BLANKS = "  "#;                                         << 2414>>20966000
IF PMASK.(13:1) THEN                                           << 2414>>23370000
IF PMASK.(14:1) THEN MOVE SPECMASK :=                          << 2414>>23410000
                       TEMPSPECMASK, (SPECMASKLN);             << 2414>>23411000
   IF PMASK.(14:1) THEN  << :ALTXXX COMMAND >>                 << 2414>>23465000
<< When we are working with NEWUSER, NEWGROUP, ALTUSER,  >>    << 2414>>23540000
<< ALTGROUP, DECODENAME will be called, instead of CHECKNAME >><< 2414>>23545000
IF LEVEL = 2 <<account>> THEN                                  << 2414>>23550000
BEGIN                                                          << 2414>>23552000
   IF NOT CHECKNAME(FANAMEBASE,NEWENTRY,FALSE) THEN RETURN     << 2414>>23555000
END                                                            << 2414>>23556000
ELSE  IF NOT DECODENAME(PARMPTR, BNEWENTRY, BCROSACCT,         << 2414>>23558000
                        PARMLEN, ERRNUM, LEVEL) THEN RETURN;   << 2414>>23560000
IF (ACCOUNT) AND NOT PMASK.(14:1) THEN  <<:NEWACCT COMMAND >>  << 2414>>23575000
   IF PMASK.(14:1) THEN                                        << 2414>>24460000
      <<10>>"PS,",                                             << 9226>>24620000
        DISKTYPESL = 145;                                      <<02350>>26575000
                9,6,"HP7936",57,                               <<01037>>26816000
                9,6,"HP7937",58,                               <<01037>>26817000
                9,6,"HP7957",59,                                        26817100
                9,6,"HP7958",60,                                        26817200
                RETURN;                                        <<01038>>27381000
        DISKTYPESL = 145;                                      <<02350>>28265000
                9,6,"HP7936",57,                               <<01037>>28501000
                9,6,"HP7937",58,                               <<01037>>28502000
                9,6,"HP7957",59,                                        28502100
                9,6,"HP7958",60,                                        28502200
      IF ERRNUM > 0 THEN                                       << 9348>>30160000
   INTEGER ARRAY CROSSACCT(0:3);                               << 2414>>30331000
   BYTE ARRAY BCRACCT(*) = CROSSACCT;                          << 2414>>30331100
   DEFINE BLANKS = "  "#;                                      << 2414>>30332000
   POINTER UCAPPTR;                                            << 2414>>30333000
   INTEGER PCBGLOBLOC;                                         << 2414>>30334000
   ARRAY QARRAY(*) = Q+0;                                      << 2414>>30334100
   LOGICAL ARRAY LACCOUNTX(*) = ACCOUNT(ACAP);                 << 2414>>30341000
MOVE CROSSACCT := "        ";                                  << 2414>>30526000
               GROUP, VSCOMM,,CROSSACCT) THEN                  << 2414>>30535000
   IF CROSSACCT <> BLANKS AND BCRACCT <> BACCOUNT,(8) THEN     << 2414>>30581000
   BEGIN                                                       << 2414>>30582000
      IF DIRECFIND(S0, 0D, CROSSACCT, ARRDB0, ARRDB0, ACCOUNT) << 2414>>30582100
         <> 0D THEN BEGIN                                      << 2414>>30582200
                    CIERR(ERRNUM := NONEXISTACCT, PARMSP);     << 2414>>30582300
                    RETURN;                                    << 2414>>30582400
                    END;                                       << 2414>>30582500
      PXGLOBAL;                                                << 2414>>30582520
      @UCAPPTR := @PXG'USERATTRIBUTES;                         << 2414>>30582530
      IF UCAPSM <> 1 THEN                                      << 2414>>30582600
      BEGIN                                                    << 2414>>30582700
         CIERR(ERRNUM := LISTACCTSMLOGON, PARMSP);             << 2414>>30582800
         RETURN;                                               << 2414>>30582900
      END;                                                     << 2414>>30583000
   END                                                         << 2414>>30583100
   ELSE                                                        << 2414>>30583200
      IF (DIRECFIND (S0, 0D, ACCOUNT, ARRDB0, ARRDB0,          << 2414>>30585000
                     ACCOUNT)) <> 0D THEN SUDDENDEATH(504);    << 2414>>30590000
$EDIT                                                          << 2414>>30595000
      CAP'ERR(ERRNUM := -ALTGRPEXCAP,CAP'DENIED);              << 1846>>30725000
          IF LOGICAL(GROUP(GLINKAGE).(PVF)) THEN               <<O2170>>30881000
             PV'USED := 1;                                     <<O2170>>30882000
   INTEGER ARRAY CROSSACCT(0:3);                               << 2414>>31006000
   BYTE ARRAY BCRACCT(*) = CROSSACCT;                          << 2414>>31006200
   DEFINE BLANKS = "  "#;                                      << 2414>>31007100
   POINTER UCAPPTR;                                            << 2414>>31008000
   INTEGER PCBGLOBLOC;                                         << 2414>>31009000
   ARRAY QARRAY(*) = Q+0;                                      << 2414>>31009100
MOVE CROSSACCT := "        ";                                  << 2414>>31015100
IF CYORGCOMS'(ERRNUM, PARMNUM, PARMSP, USERLEVEL,              << 2414>>31020000
   USER,,,CROSSACCT) THEN                                      << 2414>>31021000
   IF CROSSACCT <> BLANKS AND BCRACCT <> BACCOUNT, (8) THEN    << 2414>>31045200
   BEGIN                                                       << 2414>>31045300
      IF DIRECFIND(S0, 0D, CROSSACCT, USER, ARRDB0, ACCOUNT)   << 2414>>31045400
         <> 0D THEN BEGIN                                      << 2414>>31045500
                    CIERR(ERRNUM:=NONEXISTACCT, PARMSP);       << 2414>>31045600
                    RETURN;                                    << 2414>>31045700
                    END;                                       << 2414>>31045800
      PXGLOBAL;                                                << 2414>>31046100
      @UCAPPTR := @PXG'USERATTRIBUTES;                         << 2414>>31046110
      IF UCAPSM <> 1 THEN                                      << 2414>>31046200
      BEGIN                                                    << 2414>>31046300
         CIERR(ERRNUM := LISTACCTSMLOGON, PARMSP);             << 2414>>31046400
         RETURN;                                               << 2414>>31046500
      END;                                                     << 2414>>31046600
   END                                                         << 2414>>31048100
   ELSE                                                        << 2414>>31048200
      IF DIRECFIND(S0, 0D, ACCOUNT, ARRDB0, ARRDB0, ACCOUNT)   << 2414>>31050000
         <> 0D THEN  SUDDENDEATH(504);                         << 2414>>31055000
$EDIT                                                          << 2414>>31060000
         CAP'ERR(ERRNUM := -ALTUSERCAPS,CAP'DENIED);           << 1846>>31105000
                                                               <<S2146>>33860100
        IF SPANSPECIFIED THEN                                  <<S2146>>33860200
        BEGIN                                                  <<S2146>>33860300
            ACCOUNT (ADFSCOUNT) := 0;  ACCOUNT (X:=X+1) := 0;  <<S2146>>33860400
            ACCOUNT (ACPUCOUNT) := 0;  ACCOUNT (X:=X+1) := 0;  <<S2146>>33860500
            ACCOUNT (ACONTIMECOUNT):=0; ACCOUNT (X:=X+1):=0;   <<S2146>>33860600
            TOS.(TOLEVELF) := 0;                               <<S2146>>33860700
            TOS := DIRECINSERT (S0,0D,ACCOUNT,ARRDB0,ARRDB0,   <<S2146>>33860800
                                ACCOUNT (AGIPNTR),MVTABX);     <<S2146>>33860900
            IF <> THEN                                         <<S2146>>33861000
            BEGIN <<INSERT ERROR ON NON-SYSVS DIRECTORY>>      <<S2146>>33861100
                CYDIRERR' (*,%167000,ERRNUM);                  <<S2146>>33861200
                DEL;                                           <<S2146>>33861300
                CIERR (ERRNUM := -XXXACCTSPANFAILD);           <<S2146>>33861400
            END ELSE ASSEMBLE (DDEL,DEL);                      <<S2146>>33861500
        END <<OF SPANSPECIFIED>> ELSE DEL;                     <<S2146>>33861600
$EDIT VOID=34175000                                            <<S2146>>34100000
                     LACCOUNTX(*)     = ACCOUNT(ACAP),         << 2414>>34286000
   INTEGER ARRAY CROSSACCT(0:3);                               << 2414>>34321000
   BYTE ARRAY BCRACCT(*) = CROSSACCT;                          << 2414>>34321200
   DEFINE BLANKS = "  "#;                                      << 2414>>34322000
   POINTER UCAPPTR;                                            << 2414>>34323000
   INTEGER PCBGLOBLOC;                                         << 2414>>34324000
   ARRAY QARRAY(*) = Q+0;                                      << 2414>>34324100
MOVE CROSSACCT := "        "; <<if no acct this remian blks>>  << 2414>>34446000
          VSCOMM,DSPARMS,CROSSACCT) THEN <<list parsed ok>>    << 2414>>34455000
   IF CROSSACCT <> BLANKS AND BCRACCT <> BACCOUNT, (8) THEN    << 2414>>34501000
   BEGIN                                                       << 2414>>34502000
      IF DIRECFIND(S0,0D,CROSSACCT,ARRDB0,ARRDB0,ACCOUNT)      << 2414>>34502100
         <> 0D THEN BEGIN                                      << 2414>>34502200
                    CIERR(ERRNUM := NONEXISTACCT, PARMSP);     << 2414>>34502300
                    RETURN;                                    << 2414>>34502400
                    END;                                       << 2414>>34502500
      PXGLOBAL;                                                << 2414>>34502520
      @UCAPPTR := @PXG'USERATTRIBUTES;                         << 2414>>34502530
      IF UCAPSM <> 1 THEN                                      << 2414>>34502600
      BEGIN                                                    << 2414>>34502700
         CIERR(ERRNUM := LISTACCTSMLOGON, PARMSP);             << 2414>>34502800
         RETURN;                                               << 2414>>34502900
      END;                                                     << 2414>>34503000
   END                                                         << 2414>>34503100
   ELSE                                                        << 2414>>34503200
      IF DIRECFIND(S0,0D,ACCOUNT,ARRDB0,ARRDB0,ACCOUNT) <> 0D  << 2414>>34505000
      THEN SUDDENDEATH(504); <<discrepancy bt WHO&DIRECFIND>>  << 2414>>34510000
      CAP'ERR(ERRNUM := -ALTGRPEXCAP,CAP'DENIED);              << 1846>>34630000
       BEGIN                                                   <<O2170>>35016000
        IF LOGICAL(GROUP(GLINKAGE).(PVF)) THEN                 <<O2170>>35017000
           PV'USED := 1;                                       <<O2170>>35018000
       END;                                                    <<O2170>>35096000
   INTEGER ARRAY CROSSACCT(0:3);                               << 2414>>35185100
   BYTE ARRAY BCRACCT(*) = CROSSACCT;                          << 2414>>35185200
   DEFINE BLANKS = "  "#;                                      << 2414>>35185300
   POINTER UCAPPTR;                                            << 2414>>35185400
   INTEGER PCBGLOBLOC;                                         << 2414>>35185500
   ARRAY QARRAY(*) = Q+0;                                      << 2414>>35185600
MOVE CROSSACCT := "        ";                                  << 2414>>35196000
IF CYORGCOMS'(ERRNUM, PARMNUM, PARMSP, USERLEVEL,              << 2414>>35200000
   USER,,DSPARMS, CROSSACCT) THEN                              << 2414>>35201000
      <<all 8 chars have to be checked, not just 1st 3 chars>> << 2414>>35233000
      IF (BUSER="MANAGER " LAND (BACCOUNT="SYS     " LOR       << 2414>>35235000
         BCRACCT="SYS     ")) AND LUSERX.(0:1) <> 1 THEN       << 2414>>35240000
      IF BCRACCT=BACCOUNT,(8) LOR BCRACCT="        " THEN      << 2414>>35276000
      BEGIN                                                    << 2414>>35277000
      END;                                                     << 2414>>35286000
   IF CROSSACCT <> BLANKS AND BCRACCT <> BACCOUNT, (8) THEN    << 2414>>35311000
   BEGIN                                                       << 2414>>35311100
      IF DIRECFIND(S0, 0D, CROSSACCT, ARRDB0, ARRDB0, ACCOUNT) << 2414>>35311600
      <> 0D THEN BEGIN                                         << 2414>>35311700
                 CIERR(ERRNUM := NONEXISTACCT, PARMSP);        << 2414>>35311800
                 RETURN;                                       << 2414>>35311900
                 END;                                          << 2414>>35312000
      PXGLOBAL;                                                << 2414>>35312010
      @UCAPPTR := @PXG'USERATTRIBUTES;                         << 2414>>35312020
      IF UCAPSM <> 1 THEN                                      << 2414>>35312100
      BEGIN                                                    << 2414>>35312200
         CIERR(ERRNUM := LISTACCTSMLOGON, PARMSP);             << 2414>>35312300
         RETURN;                                               << 2414>>35312400
      END;                                                     << 2414>>35312500
   END                                                         << 2414>>35313100
   ELSE                                                        << 2414>>35313200
      IF DIRECFIND(S0, 0D, ACCOUNT, ARRDB0, ARRDB0,            << 2414>>35315000
         ACCOUNT) <> 0D THEN SUDDENDEATH(504);                 << 2414>>35320000
$EDIT                                                          << 2414>>35325000
         CAP'ERR(ERRNUM := -ALTUSERCAPS,CAP'DENIED);           << 1846>>35395000
$EDIT                                                          << 2414>>35705000
$EDIT                                                                   36725000
$EDIT                                                                   36800000
$EDIT                                                                   36890000
            IF ERRNO <> 0 THEN                                          36891000
                BEGIN                                                   36892000
                ERROR (ERRNO);                                          36893000
                GO OUTL;                                                36894000
                END;                                                    36895000
   OLDCRIT := SETCRITICAL;                                              36941000
      LOCKCOMFILE;                                                      36967000
$EDIT                                                                   36975000
   RESETCRITICAL( OLDCRIT );                                            37146000
LOGICAL DIFERACCT := FALSE;                                    << 2414>>37276000
POINTER UCAPPTR;                                               << 2414>>37277000
INTEGER PCBGLOBLOC;                                            << 2414>>37278000
ARRAY QARRAY(*) = Q+0;                                         << 2414>>37279000
INTEGER ARRAY ACCTENTRY(0:ASIZE-1);                            << 2414>>37292000
LOGICAL ARRAY LACCOUNTX(*) = ACCTENTRY(ACAP);                  << 2414>>37293000
INTEGER ARRAY CROSSACCT(0:3);                                  << 2414>>37321000
BYTE ARRAY BCROSSACCT(*) = CROSSACCT;                          << 2414>>37322000
    PVINFO := 0,                                               <<R1005>>37380000
    VSGIVEN := FALSE; <<specifies whether the VS= parameter             37381000
                              was specified in the command >>  <<21005>>37382000
<<----------------------------------------------------->>      <<D1854>>37420500
<<FILESET IS A 24 CHARACTER ARRAY SPECIFYING A FILE SET>>      <<D1854>>37420600
<< TO PASS THE LOADER DURING A PURGEGROUP,PURGEACCT.   >>      <<D1854>>37420700
<< THE LOADER IS CALLED TO TRY TO UNLOAD ANY PROGRAMS  >>      <<D1854>>37420800
<< WHICH MAY HAVE BEEN KEPT LOADED BY THE AUTOALLOCATE >>      <<D1854>>37420900
<< FEATURE IN THE GROUP/ACCOUNT TRYING TO BE DELETED.  >>      <<D1854>>37421000
<<                                                     >>      <<D1854>>37421100
<< THE FORMAT OF FILESET IS:                           >>      <<D1854>>37421200
<<          012345670123456701234567                   >>      <<D1854>>37421300
<<          FILE    GROUP   ACCOUNT                    >>      <<D1854>>37421400
<<                                                     >>      <<D1854>>37421500
<< WILD CARDS ARE ALLOWED BUT MUST FOLLOW THE          >>      <<D1854>>37421600
<< CONVENTIONS OF THE ROUTINE "DIRMATCH".              >>      <<D1854>>37421700
<< PRIMARILY IT MUST AHDERE TO THE FOLLOWING CONDITIONS>>      <<D1854>>37421800
<<     NO OCCURENCES OF "@?"                           >>      <<D1854>>37421900
<<        INSTEAD IT MUST BE "?@"                      >>      <<D1854>>37422000
<<     NO OCCURENCES OF MULTIPLE "@@@@@"               >>      <<D1854>>37422100
<<        INSTEAD IT MUST BE "@"                       >>      <<D1854>>37422200
<<----------------------------------------------------->>      <<D1854>>37422300
BYTE ARRAY FILESET(0:23) = Q;                                  <<D1854>>37422400
EQUATE GROUP'OFFSET = 8,                                       <<D1854>>37422500
       ACCOUNT'OFFSET = 16;                                    <<D1854>>37422600
                                                               <<D1854>>37422700
MOVE FILESET :="@       @       @       ";                     <<D1854>>37561000
                                                               <<D1854>>37562000
ELSE IF (PARMLEN > 8) AND NOT EMBEDEDSPECIAL THEN              << 2414>>37616000
   CIERR(ERRNUM := ERRORBASE + 3, PARM)                        << 2414>>37617000
ELSE IF INTEGER(PARMLEN) > 8 AND (TYPE<>3) AND (TYPE<>1) THEN  << 2414>>37620000
ELSE IF EMBEDEDSPECIAL AND (TYPE <> 3) AND (TYPE <> 1) THEN    << 2414>>37640000
   IF EMBEDEDSPECIAL AND ((TYPE = 3 ) OR (TYPE = 1)) THEN      << 2414>>37676000
   BEGIN                                                       << 2414>>37677000
      IF NOT DECODENAME(PARM, BTARGET, BCROSSACCT, PARMLEN,    << 2414>>37677100
         ERRNUM, TYPE) THEN RETURN;                            << 2414>>37677200
     DIFERACCT := TRUE;                                        << 2414>>37677300
   END                                                         << 2414>>37677400
   ELSE                                                        << 2414>>37677500
         MOVE BTARGET := PARM, (INTEGER(PARMLEN));             << 2414>>37680000
       VSGIVEN := TRUE;                                        <<21005>>37991000
  << Determine if cross account name is defined, if so do  >>  << 2414>>38001100
  << not use the logon acct for PURGEUSER/PURGEGROUP CMD   >>  << 2414>>38001200
   IF DIFERACCT AND BCROSSACCT <> BACCOUNT, (8) THEN           << 2414>>38001300
   BEGIN                                                       << 2414>>38001400
      MOVE ACCOUNT := "        ";                              << 2414>>38001500
      MOVE BACCOUNT := BCROSSACCT,(8);                         << 2414>>38001600
      ACCTENTRY := "  ";                                       << 2414>>38001700
      MOVE ACCTENTRY(1) := ACCTENTRY, (ASIZE-2);               << 2414>>38001800
     TOS := 0; TOS.(ENDLEVELF) := ACCOUNTLEVEL;                << 2414>>38001900
     IF DIRECFIND(S0, 0D, CROSSACCT, TARGET, ARRDB0, ACCTENTRY)<< 2414>>38002000
        <> 0D THEN BEGIN                                       << 2414>>38002100
                   CIERR(ERRNUM := NONEXISTACCT, PARMSP);      << 2414>>38002200
                   END;                                        << 2414>>38002300
     PXGLOBAL;                                                 << 2414>>38002400
     @UCAPPTR := @PXG'USERATTRIBUTES;                          << 2414>>38002500
     IF UCAPSM <> 1 THEN                                       << 2414>>38002600
     BEGIN                                                     << 2414>>38002700
        CIERR(ERRNUM := LISTACCTSMLOGON, PARMSP);              << 2414>>38002800
        RETURN;                                                << 2414>>38002900
     END;                                                      << 2414>>38003000
   END;                                                        << 2414>>38003100
      MOVE FILESET(ACCOUNT'OFFSET) := BTARGET,(8);             <<D1854>>38026000
      AUTODEALLOC'BY'NAME(FILESET);                            <<D1854>>38027000
                                                               <<D1854>>38028000
      MOVE FILESET(GROUP'OFFSET):=BTARGET,(8);                 <<D1854>>38061000
      MOVE FILESET(ACCOUNT'OFFSET):=BACCOUNT,(8);              <<D1854>>38061100
                                                               <<D1854>>38061200
      IF TYPE = GROUPLEVEL                                     <<D1854>>38061300
        THEN AUTODEALLOC'BY'NAME(FILESET);                     <<D1854>>38061400
                                                               <<D1854>>38061500
  << only if purging something not on private volumes. >>      <<21005>>38196000
  IF NOT VSGIVEN THEN                                          <<21005>>38211000
    RELEASECOMRECS(TYPE,BTARGET);                              <<01005>>38215000
$EDIT                                                          << 2414>>39090000
         CIERR(ERRNUM := REPORTEXPECTLIST,  PARM);             << 1139>>39810000
