SSUSE 
PRGM SSUSE; 
# TITLE SSUSE - INITIALIZES *SSUSE*.                                  # 
  
      BEGIN  # SSUSE #
  
# 
***   SSUSE - INITIALIZES *SSUSE*.
* 
*     THIS PRGM DOES THE INITIALIZATION FOR THE *SSUSE* 
*     UTILITY BY PROCESSING THE CONTROL CARD AND SETTING
*     UP POINTERS AND DEFAULT VALUES. 
* 
*     SSUSE,OP,FM,SM,SB,CN,CM,L.
* 
*     PRGM SSUSE. 
* 
*     ENTRY.     INPUTS TO SSUSE ARE- 
*                OP          SELECTS BASIC USAGE REPORT.
*                OP=A        OPTIONAL REPORT A AND THE BASIC REPORT.
*                OP=B        OPTIONAL REPORT B AND THE BASIC REPORT.
*                OP=C        OPTIONAL REPORT C AND THE BASIC REPORT.
*                OP=D        OPTIONAL REPORT D AND THE BASIC REPORT.
*                OP=ABCD     OPTIONAL REPORTS A, B, C, AND D AND ANY
*                            COMBINATION OF A, B, C, AND D MAY
*                            BE USED. 
*                OP OMITTED  SAME AS OP.
* 
*                FM          USE DEFAULT FAMILY.
*                FM=FAMILY   THE SPECIFIED FAMILY WILL BE REPORTED. 
*                FM OMITTED  SAME AS FM.
* 
*                SB          ALL SUBFAMILIES ARE TO BE PROCESSED. 
*                SB=CHARS    SELECT UP TO EIGHT SUBFAMILIES.  THERE 
*                            ARE EIGHT POSSIBLE SUBFAMILIES FROM 0
*                            TO 7 (E.G.  SB=723 SELECTS SUBFAMILIES 
*                            2, 3, AND 7).
*                SB OMITTED  SAME AS SB.
* 
*                SM          SM A WILL BE REPORTED. 
*                SM=CHARS    SELECT UP TO EIGHT SM-S, WHICH CAN 
*                            BE ANY OF THE FOLLOWING (E.G.  SM=AGC
*                            SELECTS SM A, C, AND G): 
*                            A - SM A 
*                            B - SM B 
*                            C - SM C 
*                            D - SM D 
*                            E - SM E 
*                            F - SM F 
*                            G - SM G 
*                            H - SM H 
*                SM OMITTED  SAME AS SM.
* 
*                L           LISTABLE OUTPUT ON FILE *OUTPUT*.
*                L=LFN       LISTABLE OUTPUT ON FILE *LFN*. 
*                L=0         NO OUTPUT FILE GENERATED.
*                L OMITTED   SAME AS L. 
* 
*                CN          NOT PERMITTED. 
*                CN=CSN      THE SELECTED CSN WILL BE REPORTED IN 
*                            REPORT D.
*                CN OMITTED  NOT PERMITTED. 
* 
*                CM          MANUFACTURER OF CARTRIDGE *CN*.  DEFAULT 
*                            MANUFACTURER IS USED.
*                CM=A        MANUFACTURER *A-* IS USED, (A- = IBM). 
*                CM OMITTED  SAME AS *CM*.
* 
*     EXIT.      *SSUSE* PROCESSING COMPLETE OR AN ERROR
*                CONDITION ENCOUNTERED. 
* 
*     MESSAGES.  1.  SSUSE COMPLETE.
*                2.  SSUSE - ARGUMENT ERROR.
*                3. SSUSE - MUST BE SYSTEM ORIGIN.
* 
*     NOTES.     PRGM *SSUSE* INITIALIZES *SSUSE*.  A PARAMETER 
*                TABLE IS SET UP BEFORE ANY PROCESSING IS DONE. 
*                *SSUSE* THEN PROCESSES THE CONTROL CARD, WHERE THE 
*                PROCESSED PARAMETERS ARE RETURNED IN THE COMMON
*                AREA *TUSPCOM*.  ANY SYNTAX ERROR IN THE CONTROL 
*                CARD CAUSES *SSUSE* TO ABORT.  AFTER THE PARAMETERS
*                ARE PROCESSED AND SYNTAX CHECKED, THEY ARE THEN
*                CHECKED BY *USOPT* TO SEE IF THE OPTIONS SPECIFIED 
*                ARE VALID.  *USOPT* ABORTS WITH A DESCRIPTIVE
*                ERROR MESSAGE WHENEVER IT ENCOUNTERS AN
*                ERROR CONDITION.  PROC *USRPBAS* IS CALLED TO
*                GENERATE THE BASIC AND OPTIONAL REPORTS.  AN 
*                *SSUSE COMPLETE* MESSAGE IS ISSUED TO THE DAYFILE
*                IF ALL REPORTS HAVE BEEN GENERATED SUCCESSFULLY. 
*     COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
# 
  
# 
****  PROC SSUSE - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # CALLS *ABORT* MACRO #
        PROC GETFAM;                 # GETS DEFAULT FAMILY #
        PROC GETPFP;                 # GET USER INDEX AND FAMILY #
        PROC GETSPS;                 # GET SYSTEM ORIGIN STATUS # 
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC SSINIT;                 # SETS UP TABLES AND POINTERS #
        PROC USOPT;                  # CHECKS FOR VALID OPTIONS # 
        PROC USRPBAS;                # GENERATES BASIC AND OPTIONAL 
                                       REPORTS #
        PROC USTAB;                  # SETS UP PARAMETER TABLE #
        PROC XARG;                   # CRACK PARAMETER LIST # 
        END 
  
# 
****  PROC SSUSE - XREF LIST END. 
# 
  
      DEF RSLEN      #1#;            # RETURN STATUS WORD LENGTH #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
                                               CONTROL PRESET;
*CALL COMBFAS 
*CALL COMBCMD 
*CALL COMBMCT 
*CALL COMBPFP 
*CALL COMXMSC 
*CALL COMSPFM 
*CALL COMTFMT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM ARGLIST    U;             # ADDRESS OF ARGUMENT TABLE #
      ITEM DEFAULT    I;             # DEFAULT FAMILY ORDINAL # 
      ITEM FAM$NUM    I;             # NUMBER OF FAMILIES # 
      ITEM FLAG       I;             # ERROR FLAG # 
      ITEM LINK       I;             # LINK FAMILY ORDINAL #
      ITEM SSID       I;             # SUBSYSTEM ID # 
  
      ARRAY SPSSTAT [0:0] S(RSLEN); 
        BEGIN 
        ITEM SPS$STATUS U(00,48,12);  # RETURN STATUS # 
        END 
  
                                               CONTROL EJECT; 
  
# 
*     IF THE USER JOB HAS SYSTEM ORIGIN PRIVILEGES THEN SAVE THE USER-S 
*     CURRENT FAMILY AND INDEX IN COMMON. 
# 
  
      GETSPS(SPSSTAT);               # GET SYSTEM ORIGIN STATUS # 
      IF SPS$STATUS NQ 0
      THEN
        BEGIN 
        SSMSG$LINE[0] = " SSUSE - MUST BE SYSTEM ORIGIN.";
        MESSAGE(SSMSG$BUF[0],SYSUDF1);
        ABORT;
        END 
  
      GETPFP(PFP[0]); 
      USER$FAM[0] = PFP$FAM[0]; 
      USER$UI[0] = PFP$UI[0]; 
  
# 
*     PROCESS THE PARAMETERS ON *SSUSE* CALL. 
# 
  
      USTAB(ARGLIST);                # SET UP THE ARGUMENT LIST # 
      XARG(ARGLIST,0,FLAG);          # PROCESS THE CONTROL STATEMENT #
      IF FLAG NQ 0
      THEN                           # SYNTAX ERROR # 
        BEGIN 
        SSMSG$LINE[0] = " SSUSE - ARGUMENT ERROR."; 
        MESSAGE(SSMSG$BUF[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
# 
*     CONVERT PARAMETERS AND CHECK FOR ALL THE VALID
*     OPTIONS ON THE CONTROL CARD.
# 
  
      USOPT;
  
# 
*     IF *FM* IS NOT SPECIFIED, USE THE DEFAULT FAMILY. 
# 
  
      SSID = ATAS;
      GETFAM(FAMT[1],FAM$NUM,LINK,DEFAULT,SSID);
      DEF$FAM = FAM$NAME[DEFAULT];
      IF USARG$FM[0] EQ 0 
      THEN
        BEGIN 
        USARG$FM[0] = DEF$FAM;
        END 
  
# 
*     INITIALIZE TABLES AND POINTERS NEEDED BY
*     CATALOG/MAP ACCESS ROUTINES.
# 
  
      SSINIT; 
  
# 
*     GENERATE THE BASIC AND OPTIONAL REPORTS REQUESTED BY
*     THE CONTROL CARD PARAMETERS.
# 
  
      USRPBAS;
  
# 
*     DISPLAY *SSUSE COMPLETE* IN THE DAYFILE.
# 
  
      SSMSG$LINE[0] = " SSUSE COMPLETE."; 
      MESSAGE(SSMSG$BUF[0],SYSUDF1);
      RESTPFP(PFP$END);              # RESTORE USER-S *PFP* # 
  
      END  # SSUSE #
  
    TERM
PROC USANALS((SUBFAM),(SMID));
# TITLE USANALS - ANALYZES SFMCATALOG ENTRIES FOR A SM.               # 
  
      BEGIN  # USANALS #
  
# 
**    USANALS - ANALYZES SFM CATALOG ENTRIES FOR A SM.
* 
*     THIS PROCEDURE ANALYZES THE *AST* AND *FCT* ENTRIES FOR A SM. 
* 
*     PROC USANALS((SUBFAM),(SMID)).
* 
*     ENTRY     (SUBFAM)   =  SUBFAMILY IDENTIFIER. 
*               (SMID)     =  SM IDENTIFIER.
* 
*     EXIT      SUB-TOTALS COUNTERS ARE UPDATED IN THE COMMON 
*               AREA. 
* 
*     MESSAGES  1. SFMCATALOG PARITY ERROR. 
*               2. FAMILY NOT FOUND.
*               3. SMMAP PARITY ERROR.
*               4. UNABLE TO OPEN SMMAP.
*               5. SSUSE ABNORMAL, USANALS. 
* 
*     NOTES     PROC *USANALS* CALLS *CRDAST* TO GET THE *AST* FOR THE
*               SPECIFIED SM.  IT THEN CALLS *CGETFCT* TO GET AN *FCT*
*               ENTRY.  THE VARIOUS FIELDS WITHIN EACH *AST* AND *FCT*
*               ENTRY ARE CHECKED FOR CERTAIN CONDITIONS AND THE
*               APPROPRIATE COUNTERS ARE UPDATED.  THE SMMAP IS 
*               SEARCHED FOR EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY. 
# 
  
      ITEM SUBFAM     I;             # SUBFAMILY IDENTIFIER # 
      ITEM SMID       U;             # SM IDENTIFIER #
  
# 
****  PROC USANALS - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC CGETFCT;                # GETS *FCT* ENTRY # 
        PROC CRDAST;                 # READS *AST* #
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MCLOSE;                 # CLOSE SMMAP #
        PROC MESSAGE;                # ISSUES MESSAGE IN DAYFILE #
        PROC MGETENT;                # GETS MAP ENTRY # 
        PROC MOPEN;                  # OPENS SMMAP #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RPCLOSE;                # CLOSES THE REPORT FILE # 
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        END 
  
# 
****  PROC USANALS - XREF LIST END. 
# 
  
      DEF PROCNAME #"USANALS."#;     # PROC NAME #
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL,COMBMAP 
*CALL,COMBPFP 
*CALL,COMSPFM 
*CALL COMBMCT 
*CALL COMXMSC 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM BADDR      I;             # *AST* BUFFER ADDRESS # 
      ITEM BFADDR     I;             # *FCT* BUFFER ADDRESS # 
      ITEM FLAG       I;             # ERROR FLAG # 
      ITEM GP         I;             # GROUP #
      ITEM I          I;             # LOOP VARIABLE #
      ITEM N          I;             # LOOP VARIABLE #
      ITEM MAP$ORD    I;             # SMMAP ORDINAL #
      ITEM SM$ADDR    I;             # ADDRESS OF SMMAP # 
      ITEM Y          I;             # Y COORDINATE # 
      ITEM Z          I;             # Z COORDINATE # 
  
      ARRAY SMMAP$NM [0:0] P(1);     # ARRAY TO BUILD SMMAP # 
        BEGIN 
        ITEM SMAP$NAME  C(00,00,07); # SMMAP FILE NAME #
        ITEM SMAP$CHAR  C(00,00,05); # FIRST FIVE CHARACTERS #
        ITEM SMAP$SMID  C(00,30,01); # SM-ID #
        ITEM SMAP$Z     U(00,36,24) = [0];  # ZERO FILL FILE NAME # 
        END 
  
                                               CONTROL EJECT; 
  
# 
*     GET THE *AST* AND CHECK THE RETURNED ERROR STATUS.
# 
  
      BADDR = LOC(US$ASTENT[0]);
      CRDAST(USARG$FM[0],SUBFAM,SMID,BADDR,0,FLAG); 
      IF FLAG NQ CMASTAT"NOERR" 
      THEN                           # UNABLE TO GET *AST* #
        BEGIN 
        SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
        MESSAGE(SSMSG$BUF[0],SYSUDF1);
        RPCLOSE(OUT$FETP);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
      P<AST> = BADDR; 
  
# 
*     PROCESS ALL *AST* AND *FCT* ENTRIES.
# 
  
      SLOWFOR I = 16 STEP 1 UNTIL PRM$ENTRC[SMID] + 15
      DO
        BEGIN  # PROCESS AN *AST* AND *FCT* ENTRY # 
  
# 
*     GET AN *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS. 
# 
  
        BFADDR = LOC(US$FCTENT[0]); 
        CGETFCT(USARG$FM[0],SUBFAM,SMID,I,BFADDR,0,FLAG); 
        IF FLAG NQ CMASTAT"NOERR" 
        THEN                         # UNABLE TO GET *FCT* #
          BEGIN 
          SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        P<FCT> = BFADDR;
        GP = I / MAXGRT;             # SET GROUP INDEX #
  
# 
*     UPDATE CUBE COUNTER AND CHECK CUBE STATUS.  IF NO CARTRIDGE 
*     ASSIGNED TO THIS CUBICLE, GET NEXT ENTRY. 
# 
  
        IF FCT$CSND[0] EQ "  "
          OR FCT$CSNI[0] EQ 0 
        THEN                         # NO CARTRIDGE ASSIGNED TO CUBE #
          BEGIN 
          TEST I; 
          END 
  
        GRP$LOC[GP] = GRP$LOC[GP] + 1;
        GRP$RES[GP] = GRP$RES[GP] + 1;  # NUM CARTRIDGES IN GROUP # 
  
# 
*     UPDATE THE AVAILABLE AU FOR SMALL AND LARGE FILES.
# 
  
        GRP$AUSF[GP] = GRP$AUSF[GP] + AST$AUSF[I];
        GRP$AULF[GP] = GRP$AULF[GP] + AST$AULF[I];
  
# 
*     CHECK FOR AVAILABLE OFF CARTRIDGE LINKS AND UPDATE THE COUNTER. 
# 
  
        IF NOT AST$NOCLF[I] 
        THEN                         # OFF CARTRIDGE LINKS AVAILABLE #
          BEGIN 
          GRP$OCL[GP] = GRP$OCL[GP] + 1;
          END 
  
# 
*     CHECK *FCT* FLAGS AND UPDATE THE APPROPRIATE COUNTERS.
# 
  
        IF FCT$IAF[0] 
        THEN                         # INHIBIT ALLOCATION # 
          BEGIN 
          GRP$INH[GP] = GRP$INH[GP] + 1;
          END 
  
        IF FCT$LCF[0] 
        THEN                         # CARTRIDGE LOST # 
          BEGIN 
          GRP$LOST[GP] = GRP$LOST[GP] + 1;
          END 
  
        IF FCT$EEF[0] 
        THEN                         # EXCESSIVE ERRORS # 
          BEGIN 
          GRP$XPE[GP] = GRP$XPE[GP] + 1;
          END 
  
        IF FCT$SEF[0] 
        THEN                         # SMMAP ERROR #
          BEGIN 
          GRP$SE[GP] = GRP$SE[GP] + 1;
          END 
  
        IF FCT$FCF[0] 
        THEN                         # FREE CARTRIDGE # 
          BEGIN 
          GRP$FRC[GP] = GRP$FRC[GP] + 1;
          END 
  
# 
*     CHECK EACH AU FOR ERRORS AND AVAILABILITY.  UPDATE THE
*     APPROPRIATE COUNTERS. 
# 
  
        SLOWFOR N = 1 STEP 1 UNTIL INAVOT 
        DO
          BEGIN  # FOR EACH AU #
  
# 
*     CHECK AU FLAGS, UPDATE COUNTERS IF NECESSARY. 
# 
  
          SETFCTX(N);                # SET *FWD* AND *FPS* VALUES # 
          IF FCT$AUCF(FWD,FPS) NQ 0 
          THEN                       # AU CONFLICT #
            BEGIN 
            GRP$AUC[GP] = GRP$AUC[GP] + 1;
            END 
  
          IF FCT$FRCF(FWD,FPS) NQ 0 
          THEN                       # FROZEN CHAIN # 
            BEGIN 
            GRP$FC[GP] = GRP$FC[GP] + 1;
            END 
  
          IF FCT$SFF(FWD,FPS) NQ 0
          THEN                       # START OF FRAGMENT #
            BEGIN 
            GRP$SF[GP] = GRP$SF[GP] + 1;
            END 
  
          IF FCT$FAUF(FWD,FPS) NQ 0 
          THEN                       # FLAWED AU #
            BEGIN 
            IF FCT$FBF(FWD,FPS) NQ 0
            THEN                     # FLAWED AND ALLOCATED # 
              BEGIN 
              GRP$FB[GP] = GRP$FB[GP] + 1;
              END 
  
            ELSE                     # FLAWED AND UNALLOCATED # 
              BEGIN 
              GRP$FA[GP] = GRP$FA[GP] +1; 
              END 
  
            END 
  
          END  # FOR EACH AU #
  
        END  # PROCESS AN *AST* AND AN *FCT* ENTRY #
  
# 
*     SEARCH THE SMMAP FOR ANY EMPTY CUBICLES ASSIGNED
*     TO THIS SUBFAMILY.
# 
  
      PFP$WRD0[0] = 0;
      PFP$FAM[0] = DEF$FAM; 
      PFP$UI[0] = DEF$UI; 
      PFP$FG1[0] = TRUE;
      PFP$FG4[0] = TRUE;
      SETPFP(PFP[0]); 
      IF PFP$STAT NQ 0
      THEN                           # FAMILY NOT FOUND # 
        BEGIN 
        SSMSG$LINE[0] = " FAMILY NOT FOUND."; 
        MESSAGE(SSMSG$BUF[0],SYSUDF1);
        RPCLOSE(OUT$FETP);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
  
      SMAP$SMID[0] = SMID;
      SMAP$CHAR[0] = SMMAP; 
  
# 
*     OPEN THE SMMAP AND CHECK THE RETURNED ERROR STATUS. 
# 
  
      MOPEN(SMID,SMAP$NAME[0],"RM",FLAG); 
      IF FLAG EQ CMASTAT"NOERR" 
      THEN
        BEGIN 
        LOFPROC(SMAP$NAME[0]);       # ADD LFN TO LIST OF FILES # 
        END 
  
      SM$ADDR = LOC(MAPBUFR[0]);
      P<SMUMAP> = SM$ADDR;
  
      IF FLAG NQ CMASTAT"NOERR" 
      THEN
        BEGIN  # SMMAP NOT OPENED SUCCESSFULLY #
        IF FLAG EQ CMASTAT"CIOERR"
        THEN
          BEGIN 
          SSMSG$LINE[0] = " SMMAP PARITY ERROR."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        IF FLAG EQ CMASTAT"INTLK"  ## 
          OR FLAG EQ CMASTAT"ATTERR"
        THEN
          BEGIN 
          SSMSG$LINE[0] = " UNABLE TO OPEN SMMAP."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        ELSE
          BEGIN 
          SSMSG$PROC[0] = PROCNAME; 
          MESSAGE(SSMSG[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        END  # SMMAP NOT OPENED SUCCESSFULLY #
  
# 
*     PROCESS EACH Y,Z PAIR.
# 
  
      SLOWFOR Y = 0 STEP 1 UNTIL MAX$Y
      DO
        BEGIN  # PROCESS EACH Y COORDINATE #
  
        SLOWFOR Z = 0 STEP 1 UNTIL MAX$Z
        DO
          BEGIN  # PROCESS EACH Z COORDINATE #
  
# 
*     DO NOT PROCESS THE COORDINATES CONTAINING THE DRD-S 
*     OR THE ENTRY-EXIT TRAY. 
# 
  
          IF (Z LQ 1               ## 
            AND (Y LQ 15 AND Y GQ 11))  ##
              OR Z EQ Z$NO$CUBE 
          THEN
            BEGIN 
            TEST Z; 
            END 
  
# 
*     CALCULATE THE ORDINAL OF THE SMMAP ENTRY. 
# 
  
          MAP$ORD = MAXORD - Z - (Y * 16);
  
# 
*     GET THE SMMAP ENTRY AND CHECK THE RETURNED ERROR STATUS.
# 
  
          MGETENT(SMID,MAP$ORD,SM$ADDR,FLAG); 
          IF FLAG NQ CMASTAT"NOERR" 
          THEN
            BEGIN  # CHECK FOR TYPE OF ERROR #
            IF FLAG EQ CMASTAT"CIOERR"
            THEN
              BEGIN 
              SSMSG$LINE[0] = " SMMAP PARITY ERROR."; 
              MESSAGE(SSMSG$BUF[0],SYSUDF1);
              RPCLOSE(OUT$FETP);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT # 
              END 
  
            ELSE
              BEGIN 
              SSMSG$PROC[0] = PROCNAME; 
              MESSAGE(SSMSG[0],SYSUDF1);
              RPCLOSE(OUT$FETP);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT # 
              END 
  
            END  # CHECK FOR TYPE OF ERROR #
  
# 
*     SEARCH FOR EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY. 
# 
  
          IF CM$CODE[0] NQ CUBSTAT"SUBFAM"
          THEN                       # NOT IN ANY SUBFAMILY # 
            BEGIN 
            TEST Z; 
            END 
  
          IF CM$FMLYNM[0] EQ USARG$FM[0]    ##
            AND CM$SUB[0] EQ SUBFAM         ##
            AND CM$FCTORD[0] EQ 0 
          THEN                       # FOUND EMPTY CUBICLE #
            BEGIN 
            GRP$LOC[0] = GRP$LOC[0] + 1;
            END 
  
          END  # PROCESS EACH Z COORDINATE #
  
        END  # PROCESS EACH Y COORDINATE #
  
# 
*     CLOSE THE SMMAP.
# 
  
      MCLOSE(SMID,FLAG);
      IF FLAG NQ CMASTAT"NOERR" 
      THEN
        BEGIN 
        SSMSG$PROC[0] = PROCNAME; 
        MESSAGE(SSMSG[0],SYSUDF1);
        RPCLOSE(OUT$FETP);
        RESTPFP(PFP$ABORT); 
        END 
  
      END  # USANALS #
  
    TERM
PROC USBASLN((SUBFAM),(SM));
# TITLE USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT.           # 
  
      BEGIN  # USBASLN #
  
# 
**    USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT. 
* 
*     THIS PROCEDURE PRINTS OUT THE BASIC USAGE REPORT INFORMATION
*     TO THE REPORT FILE. 
* 
*     PROC USBASLN((SUBFAM),(SM)).
* 
*     ENTRY.    (SUBFAM) = SUBFAMILY IDENTIFIER.
*               (SM)     = SM IDENTIFIER. 
* 
*     EXIT      BASIC REPORT LINES HAVE BEEN WRITTEN TO 
*               THE REPORT FILE.
* 
*     NOTES     PROC *USBASLN* CALLS *XCDD* TO CONVERT THE
*               GROUP TOTALS IN THE *GRP$TOT* ARRAY FROM INTEGER
*               TO DISPLAY CODE.  THESE VALUES ARE THEN DISPLAYED 
*               IN THE REPORT FILE.  TOTALS ARE ACCUMULATED FOR 
*               THE SM AND SUBFAMILY. 
# 
  
# 
****  PROC USBASLN - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILL CHARACTERS #
        PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
        PROC RPLINE;                 # WRITES A LINE TO REPORT FILE # 
        PROC RPSPACE;                # PUT BLANK LINE ON REPORT FILE #
        FUNC XCDD  C(10);            # CONVERTS INTEGERS TO DISPLAY # 
        END 
  
# 
****  PROC USBASLN - XREF LIST END. 
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBMCT 
*CALL COMXMSC 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM GP         I;             # LOOP VARIABLE #
      ITEM LN$CNT     I;             # LINE COUNT # 
      ITEM SM         I;             # SM IDENTIFIER #
      ITEM SUBFAM     I;             # SUBFAMILY IDENTIFIER # 
      ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
      ITEM TEMP$SM    C(1);          # SM CHARACTER # 
      ITEM TOT        I;             # ARRAY INDEX FOR TOTALS # 
                                               CONTROL EJECT; 
  
      TEMP$FAM = USARG$FM[0]; 
      BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
      TEMP$SM = SM; 
  
# 
*     WRITE HEADER TO REPORT FILE IF NEW PAGE.
# 
  
      IF (LN$CNT / MAX$LN) * MAX$LN EQ LN$CNT 
      THEN                           # PAGE EJECT AND PRINT HEADER #
        BEGIN 
        RPEJECT(OUT$FETP);
        RPLINE(OUT$FETP,"SSUSE BASIC REPORT",5,18,1); 
        RPLINE(OUT$FETP,"FAMILY = ",35,9,1);
        RPLINE(OUT$FETP,TEMP$FAM,44,7,0); 
  
# 
*     WRITE NOTES TO REPORT FILE. 
# 
  
        RPSPACE(OUT$FETP,SP"SPACE",1);
        RPLINE(OUT$FETP,"CUBE = CUBICLES",5,15,1);
        RPLINE(OUT$FETP,"CARTRIDGE FLAGS",36,15,1); 
        RPLINE(OUT$FETP,"AU FLAGS",86,8,0); 
        RPLINE(OUT$FETP,"CART = CARTRIDGES",5,17,1);
        RPLINE(OUT$FETP,"M = MISSING",37,11,1); 
        RPLINE(OUT$FETP,"FA = FLAWED AND ALLOCATED",87,25,0); 
        RPLINE(OUT$FETP,"I = INHIBIT ALLOCATION",37,22,1);
        RPLINE(OUT$FETP,"FU = FLAWED AND UNALLOCATED",87,27,0); 
        RPLINE(OUT$FETP,"** = SUBFAMILY TOTAL",5,20,1); 
        RPLINE(OUT$FETP,"F = FREE CARTRIDGE",37,18,1);
        RPLINE(OUT$FETP,"SF = START OF FRAGMENT",87,22,0);
        RPLINE(OUT$FETP,"-  = UNASSIGNED GROUP",5,21,1);
        RPLINE(OUT$FETP,"L = OFF CARTRIDGE LINKS AVAILABLE",37,33,1); 
        RPLINE(OUT$FETP,"FC = FROZEN CHAIN",87,17,0); 
        RPLINE(OUT$FETP,"P = EXCESSIVE PARITY ERRORS",37,27,1); 
        RPLINE(OUT$FETP,"AC = AU CONFLICT",87,16,0);
        RPLINE(OUT$FETP,"E = MAP ERROR(AS DETECTED BY SSVAL)",37,36,0); 
        RPSPACE(OUT$FETP,SP"SPACE",1);
  
# 
*     WRITE COLUMN HEADINGS TO REPORT FILE. 
# 
  
        RPLINE(OUT$FETP,"----AVAILABLE----",24,17,1); 
        RPLINE(OUT$FETP,"-----NUMBER CARTRIDGES FLAGGED----",43,34,1);
        RPLINE(OUT$FETP,"-------------NUMBER AU FLAGGED",81,30,1);
        RPLINE(OUT$FETP,"-------------",111,13,0);
        RPLINE(OUT$FETP,"SUB SM GR",1,9,1); 
        RPLINE(OUT$FETP,"CUBE  CART",12,10,1);
        RPLINE(OUT$FETP,"AU        AU",26,12,1);
        RPLINE(OUT$FETP,"M     I     F     L     P     E",46,31,1); 
        RPLINE(OUT$FETP,"FA       FU",86,11,1); 
        RPLINE(OUT$FETP,"SF       FC       AC",104,20,0); 
        RPLINE(OUT$FETP,"(SMALL)   (LARGE)",24,17,0); 
        RPSPACE(OUT$FETP,SP"SPACE",1);
        LN$CNT = 16;
        END 
  
# 
*     SET INDEX TO ACCUMULATE TOTALS. 
# 
  
      TOT = MAXGP + 1;
  
# 
*     CONVERT THE TOTALS FOR EACH GROUP TO DISPLAY CODE AND WRITE 
*     THEM TO THE REPORT FILE.  THE FIRST TIME THROUGH (GP = 0) 
*     THE NUMBER OF EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY WILL
*     BE PRINTED.  THE LAST TIME THROUGH (GP = MAXGP + 1) THE SM
*     TOTALS WILL BE PRINTED. 
# 
  
      SLOWFOR GP = 0 STEP 1 UNTIL MAXGP + 1 
      DO
        BEGIN  # FOR EACH GROUP # 
  
# 
*     WRITE GROUP SUBTOTALS TO REPORT FILE.  IF NO CUBICLES ARE 
*     ASSIGNED TO THIS GROUP, PROCESS THE NEXT GROUP. 
# 
  
        IF GP EQ MAXGP + 1
        THEN                         # PRINT TOTAL FOR ALL GROUPS # 
          BEGIN 
          CHAR$10[0] = XCDD(SUBFAM);
          RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
          RPLINE(OUT$FETP,TEMP$SM,5,1,1); 
          RPLINE(OUT$FETP,"**",8,2,1);
          END 
  
        ELSE                         # PRINT ONE GROUP AT A TIME #
          BEGIN 
          IF GRP$LOC[GP] EQ 0 
          THEN                       # NO CUBICLES IN THIS GROUP #
            BEGIN 
            TEST GP;
            END 
  
          CHAR$10[0] = XCDD(SUBFAM);
          RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
          RPLINE(OUT$FETP,TEMP$SM,5,1,1); 
          IF GP EQ 0
          THEN
            BEGIN 
            RPLINE(OUT$FETP,"-",9,1,1); 
            END 
  
          ELSE
            BEGIN 
            CHAR$10[0] = XCDD(GP);
            RPLINE(OUT$FETP,CHAR$R2[0],8,2,1);
            END 
  
          END 
  
# 
*     LIST THE NUMBER OF CUBICLES ASSIGNED TO A GROUP.
# 
  
        CHAR$10[0] = XCDD(GRP$LOC[GP]); 
        RPLINE(OUT$FETP,CHAR$R4[0],12,4,1); 
  
# 
*     LIST THE NUMBER OF CARTRIDGES IN A GROUP. 
# 
  
        CHAR$10[0] = XCDD(GRP$RES[GP]); 
        RPLINE(OUT$FETP,CHAR$R4[0],18,4,1); 
  
# 
*     LIST THE NUMBER OF AVAILABLE AU FOR SMALL AND LARGE FILES.
# 
  
        CHAR$10[0] = XCDD(GRP$AUSF[GP]);
        RPLINE(OUT$FETP,CHAR$R7[0],24,7,1); 
        CHAR$10[0] = XCDD(GRP$AULF[GP]);
        RPLINE(OUT$FETP,CHAR$R7[0],34,7,1); 
  
# 
*     LIST THE NUMBER OF LOST CARTRIDGES. 
# 
  
        CHAR$10[0] = XCDD(GRP$LOST[GP]);
        RPLINE(OUT$FETP,CHAR$R4[0],43,4,1); 
  
# 
*     LIST THE NUMBER OF CARTRIDGES WITH THE INHIBIT FLAG SET.
# 
  
        CHAR$10[0] = XCDD(GRP$INH[GP]); 
        RPLINE(OUT$FETP,CHAR$R4[0],49,4,1); 
  
# 
*     LIST THE NUMBER OF CARTRIDGES WITH FREE CARTRIDGE FLAG SET. 
# 
  
        CHAR$10[0] = XCDD(GRP$FRC[GP]); 
        RPLINE(OUT$FETP,CHAR$R4[0],55,4,1); 
  
# 
*     LIST THE NUMBER OF CARTRIDGES WITH AVAILABLE OFF-CARTRIDGE LINKS. 
# 
  
        CHAR$10[0] = XCDD(GRP$OCL[GP]); 
        RPLINE(OUT$FETP,CHAR$R4[0],61,4,1); 
  
# 
*     LIST THE NUMBER OF CARTRIDGES WITH EXCESSIVE PARITY ERRORS. 
# 
  
        CHAR$10[0] = XCDD(GRP$XPE[GP]); 
        RPLINE(OUT$FETP,CHAR$R4[0],67,4,1); 
        CHAR$10[0] = XCDD(GRP$SE[GP]);
        RPLINE(OUT$FETP,CHAR$R4[0],73,4,1); 
  
# 
*     LIST THE NUMBER OF FLAWED AND ALLOCATED AU. 
# 
  
        CHAR$10[0] = XCDD(GRP$FB[GP]);
        RPLINE(OUT$FETP,CHAR$R7[0],81,7,1); 
  
# 
*     LIST THE NUMBER OF FLAWED AND UNALLOCATED AU. 
# 
  
        CHAR$10[0] = XCDD(GRP$FA[GP]);
        RPLINE(OUT$FETP,CHAR$R7[0],90,7,1); 
  
# 
*     LIST THE NUMBER OF START OF FRAGMENT AU.
# 
  
        CHAR$10[0] = XCDD(GRP$SF[GP]);
        RPLINE(OUT$FETP,CHAR$R7[0],99,7,1); 
  
# 
*     LIST THE NUMBER OF FROZEN CHAIN AU. 
# 
  
        CHAR$10[0] = XCDD(GRP$FC[GP]);
        RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
  
# 
*     LIST THE NUMBER OF AU WITH ALLOCATION CONFLICT. 
# 
  
        CHAR$10[0] = XCDD(GRP$AUC[GP]); 
        RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
        LN$CNT = LN$CNT + 1;
  
# 
*     DO NOT ACCUMULATE TOTALS THE LAST TIME THROUGH. 
# 
  
        IF GP EQ MAXGP + 1
        THEN                         # DO NOT ADD TO TOTALS # 
          BEGIN 
          RPSPACE(OUT$FETP,SP"SPACE",1);
          LN$CNT = LN$CNT + 1;
          TEST GP;
          END 
  
# 
*     TOTALS FOR ALL GROUPS IN A SM PER SUBFAMILY ARE ACCUMULATED 
*     UNDER THE MAXGP+1 INDEX OF THE GROUP TOTALS ARRAY.
*     *GRP$TOT[MAXGP+1]*. 
# 
  
        GRP$AUC[TOT] = GRP$AUC[TOT] + GRP$AUC[GP];
        GRP$AULF[TOT] = GRP$AULF[TOT] + GRP$AULF[GP]; 
        GRP$AUSF[TOT] = GRP$AUSF[TOT] + GRP$AUSF[GP]; 
        GRP$FA[TOT] = GRP$FA[TOT] + GRP$FA[GP]; 
        GRP$FB[TOT] = GRP$FB[TOT] + GRP$FB[GP]; 
        GRP$FC[TOT] = GRP$FC[TOT] + GRP$FC[GP]; 
        GRP$FRC[TOT] = GRP$FRC[TOT] + GRP$FRC[GP];
        GRP$INH[TOT] = GRP$INH[TOT] + GRP$INH[GP];
        GRP$LOC[TOT] = GRP$LOC[TOT] + GRP$LOC[GP];
        GRP$LOST[TOT] = GRP$LOST[TOT] + GRP$LOST[GP]; 
        GRP$OCL[TOT] = GRP$OCL[TOT] + GRP$OCL[GP];
        GRP$RES[TOT] = GRP$RES[TOT] + GRP$RES[GP];
        GRP$SE[TOT] = GRP$SE[TOT] + GRP$SE[GP]; 
        GRP$SF[TOT] = GRP$SF[TOT] + GRP$SF[GP]; 
        GRP$XPE[TOT] = GRP$XPE[TOT] + GRP$XPE[GP];
        END  # FOR EACH GROUP # 
  
# 
*     ACCUMULATE SM TOTALS. 
# 
  
      SM$AUC[SM] = SM$AUC[SM] + GRP$AUC[TOT]; 
      SM$AULF[SM] = SM$AULF[SM] + GRP$AULF[TOT];
      SM$AUSF[SM] = SM$AUSF[SM] + GRP$AUSF[TOT];
      SM$FA[SM] = SM$FA[SM] + GRP$FA[TOT];
      SM$FB[SM] = SM$FB[SM] + GRP$FB[TOT];
      SM$FC[SM] = SM$FC[SM] + GRP$FC[TOT];
      SM$FRC[SM] = SM$FRC[SM] + GRP$FRC[TOT]; 
      SM$INH[SM] = SM$INH[SM] + GRP$INH[TOT]; 
      SM$LOC[SM] = SM$LOC[SM] + GRP$LOC[TOT]; 
      SM$LOST[SM] = SM$LOST[SM] + GRP$LOST[TOT];
      SM$OCL[SM] = SM$OCL[SM] + GRP$OCL[TOT]; 
      SM$RES[SM] = SM$RES[SM] + GRP$RES[TOT]; 
      SM$SE[SM] = SM$SE[SM] + GRP$SE[TOT];
      SM$SF[SM] = SM$SF[SM] + GRP$SF[TOT];
      SM$XPE[SM] = SM$XPE[SM] + GRP$XPE[TOT]; 
  
# 
*     ACCUMULATE SUBFAMILY TOTALS.
# 
  
      SF$AUC[SUBFAM] = SF$AUC[SUBFAM] + GRP$AUC[TOT]; 
      SF$AULF[SUBFAM] = SF$AULF[SUBFAM] + GRP$AULF[TOT];
      SF$AUSF[SUBFAM] = SF$AUSF[SUBFAM] + GRP$AUSF[TOT];
      SF$FA[SUBFAM] = SF$FA[SUBFAM] + GRP$FA[TOT];
      SF$FB[SUBFAM] = SF$FB[SUBFAM] + GRP$FB[TOT];
      SF$FC[SUBFAM] = SF$FC[SUBFAM] + GRP$FC[TOT];
      SF$FRC[SUBFAM] = SF$FRC[SUBFAM] + GRP$FRC[TOT]; 
      SF$INH[SUBFAM] = SF$INH[SUBFAM] + GRP$INH[TOT]; 
      SF$LOC[SUBFAM] = SF$LOC[SUBFAM] + GRP$LOC[TOT]; 
      SF$LOST[SUBFAM] = SF$LOST[SUBFAM] + GRP$LOST[TOT];
      SF$OCL[SUBFAM] = SF$OCL[SUBFAM] + GRP$OCL[TOT]; 
      SF$RES[SUBFAM] = SF$RES[SUBFAM] + GRP$RES[TOT]; 
      SF$SE[SUBFAM] = SF$SE[SUBFAM] + GRP$SE[TOT];
      SF$SF[SUBFAM] = SF$SF[SUBFAM] + GRP$SF[TOT];
      SF$XPE[SUBFAM] = SF$XPE[SUBFAM] + GRP$XPE[TOT]; 
  
      RETURN; 
  
      END  # USBASLN #
  
    TERM
PROC USBASTOT;
# TITLE USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE. # 
  
      BEGIN  # USBASTOT # 
  
# 
**    USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE. 
* 
*     PROC USBASTOT.
* 
*     ENTRY.    (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES. 
*               (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
* 
*     EXIT.     TOTALS HAVE BEEN WRITTEN TO REPORT FILE.
* 
*     NOTES.    PROC *USBASTOT* CALLS *XCDD* TO CONVERT THE VARIOUS 
*               FIELDS IN THE *SM$TOT* AND *SF$TOT* ARRAYS FROM 
*               INTEGER TO DISPLAY CODE.  THE CONVERTED VALUES ARE
*               WRITTEN TO THE REPORT FILE. 
# 
  
# 
****  PROC USBASTOT - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILL CHARACTERS #
        PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
        PROC RPLINE;                 # WRITES A LINE TO REPORT FILE # 
        PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE # 
        FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
        END 
  
# 
****  PROC USBASTOT - XREF LIST END.
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBMCT 
*CALL COMXMSC 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM SM         I;             # SM IDENTIFIER #
      ITEM SUBFAM     I;             # SUBFAMILY IDENTIFIER # 
      ITEM TEMP$FAM   C(7);          # FAMILY CHARACTER # 
      ITEM TEMP$SM    C(1);          # SM CHARACTER # 
                                               CONTROL EJECT; 
  
      TEMP$FAM = USARG$FM[0]; 
      BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  
# 
*     WRITE COLUMN HEADINGS TO REPORT FILE. 
# 
  
      RPEJECT(OUT$FETP);
      RPLINE(OUT$FETP,"SSUSE BASIC REPORT",5,18,1); 
      RPLINE(OUT$FETP,"SM AND SUBFAMILY TOTALS",27,23,1); 
      RPLINE(OUT$FETP,"FAMILY = ",54,9,1);
      RPLINE(OUT$FETP,TEMP$FAM,63,7,0); 
      RPSPACE(OUT$FETP,SP"SPACE",1);
      RPLINE(OUT$FETP,"----AVAILABLE----",24,17,1); 
      RPLINE(OUT$FETP,"-----NUMBER CARTRIDGES FLAGGED----",43,34,1);
      RPLINE(OUT$FETP,"-------------NUMBER AU FLAGGED",81,30,1);
      RPLINE(OUT$FETP,"-------------",111,13,0);
      RPLINE(OUT$FETP,"SUB SM GR",1,9,1); 
      RPLINE(OUT$FETP,"CUBE  CART",12,10,1);
      RPLINE(OUT$FETP,"AU        AU",26,12,1);
      RPLINE(OUT$FETP,"M     I     F     L     P     E",46,31,1); 
      RPLINE(OUT$FETP,"FA       FU",86,11,1); 
      RPLINE(OUT$FETP,"SF       FC       AC",104,20,0); 
      RPLINE(OUT$FETP,"(SMALL)   (LARGE)",24,17,0); 
      RPSPACE(OUT$FETP,SP"SPACE",1);
      RPLINE(OUT$FETP,"SM TOTALS FOR SPECIFIED SUBFAMILIES",1,35,0);
  
# 
*     WRITE SM TOTALS TO REPORT FILE. 
# 
  
      SLOWFOR SM = 1 STEP 1 UNTIL MAXSM 
      DO
        BEGIN  # FOR EACH SM #
        IF B<SM,1>SEL$SM EQ 0 
        THEN
          BEGIN 
          TEST SM;
          END 
  
        TEMP$SM = SM; 
  
# 
*     CONVERT VALUES TO DISPLAY CODE AND PRINT THEM.
# 
  
        RPSPACE(OUT$FETP,SP"SPACE",1);
        RPLINE(OUT$FETP,"**",2,2,1);
        RPLINE(OUT$FETP,TEMP$SM,5,1,1); 
        RPLINE(OUT$FETP,"**",8,2,1);
  
        CHAR$10[0] = XCDD(SM$LOC[SM]);
        RPLINE(OUT$FETP,CHAR$R4[0],12,4,1); 
  
        CHAR$10[0] = XCDD(SM$RES[SM]);
        RPLINE(OUT$FETP,CHAR$R4[0],18,4,1); 
  
        CHAR$10[0] = XCDD(SM$AUSF[SM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],24,7,1); 
  
        CHAR$10[0] = XCDD(SM$AULF[SM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],34,7,1); 
  
        CHAR$10[0] = XCDD(SM$LOST[SM]); 
        RPLINE(OUT$FETP,CHAR$R4[0],43,4,1); 
  
        CHAR$10[0] = XCDD(SM$INH[SM]);
        RPLINE(OUT$FETP,CHAR$R4[0],49,4,1); 
  
        CHAR$10[0] = XCDD(SM$FRC[SM]);
        RPLINE(OUT$FETP,CHAR$R4[0],55,4,1); 
  
        CHAR$10[0] = XCDD(SM$OCL[SM]);
        RPLINE(OUT$FETP,CHAR$R4[0],61,4,1); 
  
        CHAR$10[0] = XCDD(SM$XPE[SM]);
        RPLINE(OUT$FETP,CHAR$R4[0],67,4,1); 
  
        CHAR$10[0] = XCDD(SM$SE[SM]); 
        RPLINE(OUT$FETP,CHAR$R4[0],73,4,1); 
  
        CHAR$10[0] = XCDD(SM$FB[SM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],81,7,1); 
  
        CHAR$10[0] = XCDD(SM$FA[SM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],90,7,1); 
  
        CHAR$10[0] = XCDD(SM$SF[SM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],99,7,1); 
  
        CHAR$10[0] = XCDD(SM$FC[SM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
  
        CHAR$10[0] = XCDD(SM$AUC[SM]);
        RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
        END  # FOR EACH SM #
  
      RPSPACE(OUT$FETP,SP"SPACE",2);
      RPLINE(OUT$FETP,"SUBFAMILY TOTALS FOR SPECIFIED SM-S",1,35,0);
  
# 
*     WRITE SUBFAMILY TOTALS TO REPORT FILE.
# 
  
      SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF 
      DO
        BEGIN  # FOR EACH SUBFAMILY # 
        IF B<SUBFAM,1>SEL$SB EQ 0 
        THEN
          BEGIN 
          TEST SUBFAM;
          END 
  
# 
*     CONVERT VALUES TO DISPLAY CODE AND PRINT THEM.
# 
  
        RPSPACE(OUT$FETP,SP"SPACE",1);
        CHAR$10[0] = XCDD(SUBFAM);
        RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
        RPLINE(OUT$FETP,"**",5,2,1);
        RPLINE(OUT$FETP,"**",8,2,1);
  
        CHAR$10[0] = XCDD(SF$LOC[SUBFAM]);
        RPLINE(OUT$FETP,CHAR$R4[0],12,4,1); 
  
        CHAR$10[0] = XCDD(SF$RES[SUBFAM]);
        RPLINE(OUT$FETP,CHAR$R4[0],18,4,1); 
  
        CHAR$10[0] = XCDD(SF$AUSF[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],24,7,1); 
  
        CHAR$10[0] = XCDD(SF$AULF[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],34,7,1); 
  
        CHAR$10[0] = XCDD(SF$LOST[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R4[0],43,4,1); 
  
        CHAR$10[0] = XCDD(SF$INH[SUBFAM]);
        RPLINE(OUT$FETP,CHAR$R4[0],49,4,1); 
  
        CHAR$10[0] = XCDD(SF$FRC[SUBFAM]);
        RPLINE(OUT$FETP,CHAR$R4[0],55,4,1); 
  
        CHAR$10[0] = XCDD(SF$OCL[SUBFAM]);
        RPLINE(OUT$FETP,CHAR$R4[0],61,4,1); 
  
        CHAR$10[0] = XCDD(SF$XPE[SUBFAM]);
        RPLINE(OUT$FETP,CHAR$R4[0],67,4,1); 
  
        CHAR$10[0] = XCDD(SF$SE[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R4[0],73,4,1); 
  
        CHAR$10[0] = XCDD(SF$FB[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],81,7,1); 
  
        CHAR$10[0] = XCDD(SF$FA[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],90,7,1); 
  
        CHAR$10[0] = XCDD(SF$SF[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],99,7,1); 
  
        CHAR$10[0] = XCDD(SF$FC[SUBFAM]); 
        RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
  
        CHAR$10[0] = XCDD(SF$AUC[SUBFAM]);
        RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
        END  # FOR EACH SUBFAMILY # 
  
      RETURN; 
  
      END  # USBASTOT # 
  
    TERM
PROC USHEAD((FETP));
# TITLE USHEAD - WRITES HEADER ON OUTPUT FILE.                        # 
  
      BEGIN  # USHEAD # 
  
# 
**    USHEAD - WRITES HEADER LINE ON OUTPUT FILE. 
* 
*     PROC USHEAD((FETP)).
* 
*     ENTRY     (FETP) = AN ITEM CONTAINING THE FWA OF THE FET. 
* 
*     EXIT      HEADER IS WRITTEN ON THE OUTPUT FILE. 
* 
*     NOTES     THE REPORT FORMATTER IS USED TO 
*               PRINT THE HEADER LINES. 
# 
  
      ITEM FETP       I;             # FWA OF THE FET # 
  
# 
****  PROC USHEAD - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC RPLINEX;                # PRINTS A REPORT LINE # 
        END 
  
# 
****  PROC USHEAD - XREF LIST END.
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
  
                                               CONTROL EJECT; 
  
# 
*     PRINT THE HEADER LINE.
# 
  
      RPLINEX(FETP,"SSUSE REPORT FILE",2,17,0); 
      RPLINEX(FETP," ",1,1,0);       # WRITE A BLANK LINE # 
      RETURN; 
  
      END  # USHEAD # 
  
    TERM
PROC USOPT; 
# TITLE USOPT - CONVERTS PARAMETERS AND CHECKS FOR VALID OPTIONS.     # 
  
      BEGIN  # USOPT #
  
# 
**    USOPT - CONVERTS AND CHECKS PARAMETERS FOR ALL VALID OPTIONS. 
* 
*     THIS PROC CHECKS PARAMETERS FOR LEGALITY.  IF INVALID OPTIONS ARE 
*     FOUND IT ISSUES A DAYFILE MESSAGE AND THEN ABORTS.
* 
*     ENTRY     PARAMETERS PROCESSED AND SET UP IN *TUSPCOM*. 
* 
*     EXIT      ALL OPTIONS HAVE BEEN VALIDATED, OR IF VALID
*               OPTIONS HAVE BEEN MISUSED, THE PROC ISSUES A
*               DAYFILE MESSAGE AND THEN ABORTS.
* 
*     MESSAGES  1)  INCORRECT SM. 
*               2)  INCORRECT SUBFAMILY.
*               3)  INCORRECT REPORT OPTION.
*               4)  DUPLICATE SM. 
*               5)  DUPLICATE SUBFAMILY.
*               6)  DUPLICATE OPTION. 
*               7)  CN NOT SPECIFIED. 
* 
*     NOTES     ALL PARAMETER OPTIONS ARE TESTED FOR INVALID OPTIONS. 
*               THE VALID OPTIONS ON *SSUSE* CALLS ARE
*                   1.  *OP* MUST EITHER CONTAIN ANY COMBINATION OF THE 
*                       VALID CHARACTERS A, B, C, OR D, OR IT CAN BE
*                       OMITTED.
*                   2.  *SM* MUST BE A VALID SM NAME OR A VALID 
*                       COMBINATION OF VALID SM NAMES, OR IT CAN BE 
*                       OMITTED.
*                   3.  *SB* MUST BE FROM 0 TO 7 OR A VALID COMBINATION 
*                       OF LEGAL SUBFAMILY NUMBERS, OR IT CAN BE OMITTED
*                   4.  *CN* MUST BE SPECIFIED IF REPORT D IS SELECTED. 
*               ANY VIOLATION OF THE VALID OPTIONS CAUSES A MESSAGE 
*               TO BE PRINTED IN THE DAYFILE AND CAUSES PROC
*               *USOPT* TO ABORT. 
# 
  
# 
****  PROC USOPT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILLS CHARACTERS # 
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        END 
  
# 
****  PROC USOPT - XREF LIST END. 
# 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL,COMBBZF 
*CALL COMBMCT 
*CALL COMXMSC 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM I          I;             # LOOP VARIABLE #
      ITEM MORE       B;             # MORE SM-ID/SUBFAMILY INDICATOR # 
      ITEM SMARG      C(10);         # SM ARGUMENTS # 
      ITEM TEMPC      C(1);          # TEMPORARY CHARACTER #
  
                                               CONTROL EJECT; 
  
# 
*     CHECK ALL SPECIFIED VALUES OF *SM*. 
# 
  
      MORE = TRUE;
      SMARG = USARG$SM[0];
      BZFILL(SMARG,TYPFILL"BFILL",10);
      SLOWFOR I = 0 STEP 1 WHILE I LS MAXSM AND MORE
      DO
        BEGIN  # CHECK SPECIFIED SM-ID-S #
        TEMPC = C<I,1>SMARG;
        IF TEMPC EQ " " 
        THEN                         # NO MORE SM-ID-S #
          BEGIN 
          MORE = FALSE; 
          TEST I; 
          END 
  
        IF TEMPC GR "H" OR TEMPC LS "A" 
        THEN                         # INCORRECT SM # 
          BEGIN 
          SSMSG$LINE[0] = " INCORRECT SM."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        IF B<TEMPC,1>SEL$SM EQ 1
        THEN                         # DUPLICATE SM # 
          BEGIN 
          SSMSG$LINE[0] = " DUPLICATE SM."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        B<TEMPC,1>SEL$SM = 1;        # TURN SM BIT ON # 
        END  # CHECK SPECIFIED SM-ID-S #
  
# 
*     CHECK ALL SPECIFIED VALUES OF *SB*. 
# 
  
      MORE = TRUE;
      SLOWFOR I = 0 STEP 1 WHILE I LQ MAXSF AND MORE
      DO
        BEGIN  # CHECK SPECIFIED SUBFAMILIES #
        TEMPC = C<I,1>USARG$SB[0];
        IF TEMPC EQ 0 
        THEN                         # NO MORE SUBFAMILIES #
          BEGIN 
          MORE = FALSE; 
          TEST I; 
          END 
  
        IF TEMPC LS "0" OR TEMPC GR "7" 
        THEN                         # INCORRECT SUBFAMILY #
          BEGIN 
          SSMSG$LINE[0] = " INCORRECT SUBFAMILY.";
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        IF B<TEMPC - "0",1>SEL$SB EQ 1
        THEN                         # DUPLICATE SUBFAMILY #
          BEGIN 
          SSMSG$LINE[0] = " DUPLICATE SUBFAMILY.";
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        B<TEMPC - "0",1>SEL$SB = 1;  # TURN SUBFAMILY BIT ON #
        END  # CHECK SPECIFIED SUBFAMILIES #
  
# 
*     CHECK THE VALUES OF *OP*. 
# 
  
      REPORT$A = FALSE; 
      REPORT$B = FALSE; 
      REPORT$C = FALSE; 
      REPORT$D = FALSE; 
  
      SLOWFOR I = 0 STEP 1 UNTIL 9
      DO
        BEGIN  # CHECK ALL VALUES OF *OP* # 
        TEMPC = C<I,1>USARG$OP[0];
        IF TEMPC NQ 0 
        THEN
          BEGIN  # CHECK SPECIFIED *OP* # 
          IF TEMPC GR "D" OR TEMPC LS "A" 
          THEN
            BEGIN 
            SSMSG$LINE[0] = " INCORRECT REPORT OPTION.";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          ELSE
            BEGIN  # SET APPROPRIATE FLAG # 
            IF TEMPC EQ "A" 
            THEN                     # REPORT A SELECTED #
              BEGIN 
              IF NOT REPORT$A 
              THEN                   # UNIQUE OPTION #
                BEGIN 
                REPORT$A = TRUE;
                TEST I; 
                END 
  
              ELSE                   # DUPLICATE OPTION # 
                BEGIN 
                SSMSG$LINE[0] = " DUPLICATE OPTION."; 
                MESSAGE(SSMSG$BUF[0],SYSUDF1);
                RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT # 
                END 
  
              END 
  
            IF TEMPC EQ "B" 
            THEN                     # REPORT B SELECTED #
              BEGIN 
              IF NOT REPORT$B 
              THEN                   # UNIQUE OPTION #
                BEGIN 
                REPORT$B = TRUE;
                TEST I; 
                END 
  
              ELSE                   # DUPLICATE OPTION # 
                BEGIN 
                SSMSG$LINE[0] = " DUPLICATE OPTION."; 
                MESSAGE(SSMSG$BUF[0],SYSUDF1);
                RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT # 
                END 
  
              END 
  
            IF TEMPC EQ "C" 
            THEN                     # REPORT C SELECTED #
              BEGIN 
              IF NOT REPORT$C 
              THEN                   # UNIQUE OPTION #
                BEGIN 
                REPORT$C = TRUE;
                TEST I; 
                END 
  
              ELSE                   # DUPLICATE OPTION # 
                BEGIN 
                SSMSG$LINE[0] = " DUPLICATE OPTION."; 
                MESSAGE(SSMSG$BUF[0],SYSUDF1);
                RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT # 
                END 
  
              END 
  
            IF TEMPC EQ "D" 
            THEN                     # REPORT D SELECTED #
              BEGIN 
              IF NOT REPORT$D 
              THEN                   # UNIQUE OPTION #
                BEGIN 
                REPORT$D = TRUE;
                TEST I; 
                END 
  
              ELSE                   # DUPLICATE OPTION # 
                BEGIN 
                SSMSG$LINE[0] = " DUPLICATE OPTION."; 
                MESSAGE(SSMSG$BUF[0],SYSUDF1);
                RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT # 
                END 
  
              END 
  
            END  # SET APPROPRIATE FLAG # 
  
          END  # CHECK SPECIFIED *OP* # 
  
        END  # CHECK ALL VALUES OF *OP* # 
  
# 
*     CHECK THAT *CN* IS SPECIFIED IF REPORT D IS SELECTED. 
# 
  
      IF REPORT$D 
      THEN
        BEGIN  # CHECK *CN* # 
        IF USARG$CN[0] EQ 0 
        THEN
          BEGIN 
          SSMSG$LINE[0] = " CN NOT SPECIFIED."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        END  # CHECK *CN* # 
  
      IF USARG$CM[0] NQ 0 
      THEN
        BEGIN 
        C<1,1>USARG$CM[0] = "-";
        END 
  
      RETURN; 
  
      END  # USOPT #
  
    TERM
PROC USRPBAS; 
# TITLE USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS.     # 
  
      BEGIN  # USRPBAS #
  
# 
**    USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS. 
* 
*     THIS PROCEDURE GENERATES THE BASIC REPORT AND ANY OPTIONAL
*     REPORTS SELECTED FOR ALL THE SM-S AND SUBFAMILIES SPECIFIED.
* 
*     PROC USRPBAS. 
* 
*     ENTRY     PROCESSED AND SYNTAX-CHECKED PARAMETERS SET UP IN 
*               *TUSPCOM*.
*               (USARG$FM) = FAMILY NAME. 
*               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
*               (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES. 
*               (REPORT$A) = OPTIONAL REPORT SELECTION CODE,
*                              TRUE, REPORT A SELECTED, 
*                              FALSE, REPORT A NOT SELECTED.
*               (REPORT$B) = OPTIONAL REPORT SELECTION CODE,
*                              TRUE, REPORT B SELECTED, 
*                              FALSE, REPORT B NOT SELECTED.
*               (REPORT$C) = OPTIONAL REPORT SELECTION CODE,
*                              TRUE, REPORT C SELECTED, 
*                              FALSE, REPORT C NOT SELECTED.
*               (REPORT$D) = OPTIONAL REPORT SELECTION CODE,
*                              TRUE, REPORT D SELECTED, 
*                              FALSE, REPORT D NOT SELECTED.
* 
*     EXIT      ALL SPECIFIED REPORTS HAVE BEEN GENERATED.
* 
*     MESSAGES  1)  FAMILY NOT FOUND. 
*               2)  UNABLE TO OPEN CATALOG. 
*               3)  SSUSE ABNORMAL, USRPBAS.
*               4)  SFM CATALOG PARITY ERROR. 
* 
*     NOTES     *USRPBAS* GENERATES THE BASIC REPORT FOR ALL SM-S 
*               SPECIFIED FOR ALL OF THE SUBFAMILIES SPECIFIED IN 
*               THE BITS OF *SEL$SB*.  IF ANY OPTIONAL REPORTS
*               ARE DESIRED, *USRPBAS* CALLS THE APPROPRIATE ROUTINES 
*               TO GENERATE THOSE REPORTS.
# 
  
# 
****  PROC USRPBAS - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILLS CHARACTERS # 
        PROC CCLOSE;                 # CLOSES THE CATALOG # 
        PROC COPEN;                  # OPENS THE CATALOG #
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RPCLOSE;                # CLOSES THE REPORT FILE # 
        PROC RPEJECT;                # PAGE EJECTS THE REPORT FILE #
        PROC RPLINE;                 # WRITES LINE TO REPORT FILE # 
        PROC RPOPEN;                 # OPENS THE REPORT FILE #
        PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE # 
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        PROC USANALS;                # ANALYZE *FCT* ENTRIES FOR A SM # 
        PROC USBASLN;                # PRINTS LINE ON BASIC REPORT #
        PROC USBASTOT;               # PRINTS TOTAL ON BASIC REPORT # 
        PROC USHEAD;                 # WRITES HEADER ON OUTPUT FILE # 
        PROC USRPTA;                 # GENERATES OPTIONAL REPORT A #
        PROC USRPTB;                 # GENERATES OPTIONAL REPORT B #
        PROC USRPTC;                 # GENERATES OPTIONAL REPORT C #
        PROC USRPTD;                 # GENERATES OPTIONAL REPORT D #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        FUNC XCDD  C(10);            # CONVERTS INTEGERS TO DISPLAY # 
        END 
  
# 
****  PROC USRPBAS - XREF LIST END. 
# 
  
      DEF PROCNAME #"USRPBAS."#;     # PROC NAME #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBMCT 
*CALL COMBPFP 
*CALL COMXMSC 
*CALL COMSPFM 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM EJEC$FLAG  B;             # FLAG TO TEST FOR EJECT # 
      ITEM FLAG       I;             # ERROR FLAG # 
      ITEM GROUP      I;             # LOOP VARIABLE #
      ITEM SM         I;             # LOOP VARIABLE #
      ITEM SUBFAM     I;             # LOOP VARIABLE #
      ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
      ITEM TEMP$SM    C(1);          # SM CHARACTER # 
  
      ARRAY OUT$FET [0:0] S(SFETL);;  # FET FOR OUTPUT FILE # 
  
                                               CONTROL EJECT; 
  
# 
*     SET THE FET POINTER FOR THE OUTPUT FILE.
# 
  
      IF USARG$LZ[0] EQ 0 
      THEN                           # NO OUTPUT FILE # 
        BEGIN 
        OUT$FETP = 0; 
        END 
  
      ELSE                           # SET UP THE FWA OF THE FET #
        BEGIN 
        OUT$FETP = LOC(OUT$FET[0]); 
        END 
  
# 
*     OPEN THE OUTPUT FILE. 
# 
  
      RPOPEN(USARG$L[0],OUT$FETP,USHEAD); 
  
# 
*     CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
# 
  
      TEMP$FAM = USARG$FM[0]; 
      BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  
# 
*     GENERATE THE BASIC REPORT ON EACH SUBFAMILY SPECIFIED.
# 
  
      EJEC$FLAG = FALSE;             # DO NOT EJECT ON FIRST PAGE # 
      SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF 
      DO
        BEGIN  # PROCESS EACH SUBFAMILY # 
        IF B<SUBFAM,1>SEL$SB EQ 0 
        THEN                         # SUBFAMILY NOT SELECTED # 
          BEGIN 
          TEST SUBFAM;
          END 
  
# 
*     SWITCH TO THE SPECIFIED FAMILY AND USER INDEX FOR 
*     THE SELECTED SUBFAMILY. 
# 
  
        PFP$WRD0[0] = 0;
        PFP$FAM[0] = USARG$FM[0]; 
        PFP$UI[0] = DEF$UI + SUBFAM;
        PFP$FG1[0] = TRUE;
        PFP$FG4[0] = TRUE;
        SETPFP(PFP[0]); 
        IF PFP$STAT[0] NQ 0 
        THEN                         # FAMILY NOT FOUND # 
          BEGIN 
          SSMSG$LINE[0] = " FAMILY NOT FOUND."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
# 
*     OPEN THE CATALOG FOR THE SUBFAMILY AND CHECK THE RETURNED 
*     ERROR STATUS. 
# 
  
        CHAR$10[0] = XCDD(SUBFAM);
        SFMCAT$LST[0] = CHAR$R1[0]; 
        COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG); 
        IF FLAG EQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES # 
          END 
  
        IF FLAG NQ CMASTAT"NOERR" 
        THEN
          BEGIN  # CHECK FOR ERROR TYPE # 
          IF FLAG EQ CMASTAT"INTLK"  ## 
            OR FLAG EQ CMASTAT"ATTERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG."; 
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          IF FLAG EQ CMASTAT"CIOERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          ELSE
            BEGIN 
            SSMSG$PROC[0] = PROCNAME; 
            MESSAGE(SSMSG[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          END  # CHECK FOR ERROR TYPE # 
  
# 
*     GENERATE BASIC REPORT DETAIL LINES FOR EACH SM SPECIFIED. 
# 
  
        SLOWFOR SM = 1 STEP 1 UNTIL MAXSM 
        DO
          BEGIN  # PROCESS EACH SM #
          IF B<SM,1>SEL$SM EQ 0 
          THEN                       # SM NOT SELECTED #
            BEGIN 
            TEST SM;
            END 
  
          TEMP$SM = SM; 
  
# 
*     CLEAR THE SUB-TOTAL COUNTERS FOR EACH GROUP.
# 
  
          ZFILL(GRP$TOT,8*MAXGP); 
  
          IF EJEC$FLAG
          THEN                       # NOT FIRST PAGE # 
            BEGIN 
            RPEJECT(OUT$FETP);
            END 
  
# 
*     CHECK THE NUMBER OF *FCT* ENTRIES FOR THIS SM.  IF NONE, PRINT
*     AN APPROPRIATE MESSAGE AND PROCESS THE NEXT SPECIFIED SM. 
# 
  
          P<PREAMBLE> = PRMBADR;     # SET PREAMBLE TABLE ADDRESS # 
          IF PRM$SCW1[SM] EQ 0
          THEN                       # SM NOT ASSIGNED TO SUBFAMILY # 
            BEGIN 
            RPLINE(OUT$FETP,"SM ",3,3,1); 
            RPLINE(OUT$FETP,TEMP$SM,6,1,1); 
            RPLINE(OUT$FETP," NOT ASSIGNED TO SUBFAMILY  .",7,29,1);
            CHAR$10[0] = XCDD(SUBFAM);
            RPLINE(OUT$FETP,CHAR$R1[0],34,1,0); 
            RPSPACE(OUT$FETP,SP"SPACE",1);
            TEST SM;
            END 
  
# 
*     ANALYZE THE *AST* AND *FCT* ENTRIES FOR THE SELECTED SM.  SET UP
*     THE SUB-TOTALS COUNTERS.
# 
  
          USANALS(SUBFAM,SM); 
  
# 
*     DISPLAY THE SUB-TOTALS COUNTERS ON THE REPORT FILE. 
# 
  
          USBASLN(SUBFAM,SM); 
  
          END  # PROCESS EACH SM #
  
# 
*     CLOSE THE SFM CATALOG.
# 
  
        CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
        IF FLAG NQ CMASTAT"NOERR" 
        THEN                         # UNABLE TO CLOSE CATALOG #
          BEGIN 
          SSMSG$PROC[0] = PROCNAME; 
          MESSAGE(SSMSG[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER # 
  
        END  # PROCESS EACH SUBFAMILY # 
  
# 
*     WRITE SM AND SUBFAMILY TOTALS TO REPORT FILE. 
# 
  
      USBASTOT; 
  
# 
*     CALL SPECIFIED OPTIONAL REPORTS.
# 
  
      IF REPORT$A 
      THEN                           # OPTIONAL REPORT A SPECIFIED #
        BEGIN 
        USRPTA; 
        END 
  
      IF REPORT$B 
      THEN                           # OPTIONAL REPORT B SPECIFIED #
        BEGIN 
        USRPTB; 
        END 
  
      IF REPORT$C 
      THEN                           # OPTIONAL REPORT C SPECIFIED #
        BEGIN 
        USRPTC; 
        END 
  
      IF REPORT$D 
      THEN                           # OPTIONAL REPORT D SPECIFIED #
        BEGIN 
        USRPTD; 
        END 
  
# 
*     CLOSE THE REPORT FILE.
# 
  
      RPCLOSE(OUT$FETP);
  
      RETURN; 
  
      END  # USRPBAS #
  
    TERM
PROC USRPTA;
# TITLE USRPTA - GENERATES OPTIONAL REPORT A.                         # 
  
      BEGIN  # USRPTA # 
  
# 
**    USRPTA - GENERATES OPTIONAL REPORT A. 
* 
*     THIS PROC LISTS THE CONTENTS OF A STORAGE MODULE AS DESCRIBED 
*     IN THE SMMAP. 
* 
*     PROC USRPTA.
* 
*     ENTRY.    (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES. 
*               (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
* 
*     EXIT.     OPTIONAL REPORT A GENERATED.
* 
*     MESSAGES. 1) SMMAP PARITY ERROR.
*               2) UNABLE TO OPEN SMMAP.
*               3) SSUSE ABNORMAL, USRPTA.
*               4) FAMILY NOT FOUND.
* 
*     NOTES.    FOR EACH SELECTED SM, PROC *USRPTA* OPENS THE 
*               CORRESPONDING SMMAP AND PRINTS THE CONTENTS 
*               OF THE Y,Z COORDINATES.  THE COLUMN CONTAINING
*               THE DRD-S IS NOT REPORTED ON.  THIS REPORT IS FIFTEEN 
*               PAGES LONG WITH 1 Z AND 22 Y COORDINATES
*               LISTED PER PAGE.
# 
  
# 
****  PROC USRPTA - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILLS CHARACTERS # 
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MCLOSE;                 # CLOSES SMMAP # 
        PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
        PROC MGETENT;                # GETS SMMAP ENTRY # 
        PROC MOPEN;                  # OPENS SMMAP #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RPCLOSE;                # CLOSES THE REPORT FILE # 
        PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
        PROC RPLINE;                 # WRITES LINE TO REPORT FILE # 
        PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE # 
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
        END 
  
# 
****  PROC USRPTA - XREF LIST END.
# 
  
      DEF PROCNAME #"USRPTA."#;      # PROC NAME #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBMAP 
*CALL COMBMCT 
*CALL COMBPFP 
*CALL COMSPFM 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM FLAG       I;             # ERROR FLAG # 
      ITEM GP         I;             # GROUP #
      ITEM GRT        I;             # GROUP ORDINAL #
      ITEM MAP$ORD    I;             # SMMAP ORDINAL #
      ITEM RPTFLAG    C(7);          # REPORT FLAG #
      ITEM SM         I;             # LOOP VARIABLE #
      ITEM SM$ADDR    I;             # ADDRESS OF SMMAP # 
      ITEM TEMP$SM    C(1);          # SM CHARACTER # 
      ITEM Y          I;             # LOOP VARIABLE #
      ITEM Z          I;             # LOOP VARIABLE #
  
      ARRAY SMMAP$NM [0:0] P(1);     # ARRAY TO BUILD SMMAP # 
        BEGIN 
        ITEM SMAP$NAME  C(00,00,07);  # SMMAP FILE NAME # 
        ITEM SMAP$CHAR  C(00,00,05);  # FIRST FIVE CHARACTERS # 
        ITEM SMAP$SMID  C(00,30,01);  # SM-ID # 
        ITEM SMAP$Z     U(00,36,24) = [0];  # ZERO FILL FILE NAME # 
        END 
  
  
                                               CONTROL EJECT; 
  
# 
*     SET DEFAULT FAMILY AND USER INDEX.
# 
  
      PFP$WRD0[0] =0; 
      PFP$FAM[0] = DEF$FAM; 
      PFP$UI[0] = DEF$UI; 
      PFP$FG1[0] = TRUE;
      PFP$FG4[0] = TRUE;
      SETPFP(PFP[0]); 
      IF PFP$STAT NQ 0
      THEN                           # FAMILY NOT FOUND # 
        BEGIN 
        SSMSG$LINE[0] = " FAMILY NOT FOUND."; 
        MESSAGE(SSMSG$BUF[0],SYSUDF1);
        RPCLOSE(OUT$FETP);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
# 
*     PROCESS EACH SPECIFIED SM.
# 
  
      SLOWFOR SM = 1 STEP 1 UNTIL MAXSM 
      DO
        BEGIN  # PROCESS EACH SM #
        IF B<SM,1>SEL$SM EQ 0 
        THEN                         # SM NOT SELECTED #
          BEGIN 
          TEST SM;
          END 
  
        TEMP$SM = SM; 
        SMAP$SMID[0] = TEMP$SM; 
        SMAP$CHAR[0] = SMMAP; 
  
# 
*     OPEN THE SMMAP AND CHECK THE RETURNED ERROR STATUS. 
# 
  
        MOPEN(SM,SMAP$NAME[0],"RM",FLAG); 
        IF FLAG EQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          LOFPROC(SMAP$NAME[0]);     # ADD LFN TO LIST OF FILES # 
          END 
  
        SM$ADDR = LOC(MAPBUFR[0]);
        P<SMUMAP> = SM$ADDR;
  
        IF FLAG NQ CMASTAT"NOERR" 
        THEN
          BEGIN  # SMMAP NOT OPENED SUCCESSFULLY #
          IF FLAG EQ CMASTAT"CIOERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " SMMAP PARITY ERROR."; 
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          IF FLAG EQ CMASTAT"INTLK"  ## 
            OR FLAG EQ CMASTAT"ATTERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " UNABLE TO OPEN SMMAP."; 
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          ELSE
            BEGIN 
            SSMSG$PROC[0] = PROCNAME; 
            MESSAGE(SSMSG[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          END  # SMMAP NOT OPENED SUCCESSFULLY #
  
# 
*     PROCESS EACH Y,Z PAIR.
# 
  
        SLOWFOR Z = 0 STEP 1 UNTIL MAX$Z
        DO
          BEGIN  # PROCESS EACH Z COORDINATE #
  
# 
*     DO NOT PROCESS THE COLUMN CONTAINING THE DRD-S. 
# 
  
          IF Z EQ Z$NO$CUBE 
          THEN
            BEGIN 
            TEST Z; 
            END 
  
# 
*     WRITE HEADER TO REPORT FILE.
# 
  
            RPEJECT(OUT$FETP);
            RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT A - ",5,26,1); 
            RPLINE(OUT$FETP,"STORAGE MODULE MAP FOR SM = ",31,28,1);
            RPLINE(OUT$FETP,TEMP$SM,59,1,0);
            RPSPACE(OUT$FETP,SP"SPACE",1);
            RPLINE(OUT$FETP,"FLAGS:",5,6,1);
            RPLINE(OUT$FETP,"P = CARTRIDGE EXISTS IN POOL",15,28,1);
            RPLINE(OUT$FETP,"S = RESERVED FOR SYSTEM USE",49,27,1); 
            RPLINE(OUT$FETP,"C = RESERVED FOR CUSTOMER ",81,26,1);
            RPLINE(OUT$FETP,"ENGINEERING",107,11,0);
            RPLINE(OUT$FETP,"F = NOT ASSIGNED TO THIS FAMILY",15,31,1); 
            RPLINE(OUT$FETP,"E = ERROR FLAG",49,14,1);
            RPLINE(OUT$FETP,"N = (Y,Z) DOES NOT EXIST",81,24,1);
            RPLINE(OUT$FETP," IN SMMAP",105,9,0); 
            RPLINE(OUT$FETP,"R = RESERVED FOR ALTERNATE SMMAP",15,32,1);
            RPLINE(OUT$FETP,"GPORD = ORDINAL IN GROUP",81,24,0);
            RPSPACE(OUT$FETP,SP"SPACE",1);
            RPLINE(OUT$FETP,"Y     Z    CM  CSN",6,18,1); 
            RPLINE(OUT$FETP,"FAMILY      SUBFAMILY",30,21,1); 
            RPLINE(OUT$FETP,"GROUP    GPORD     FLAGS",56,24,0);
            RPSPACE(OUT$FETP,SP"SPACE",1);
  
          SLOWFOR Y = 0 STEP 1 UNTIL MAX$Y
          DO
            BEGIN  # PROCESS EACH Y COORDINATE #
  
# 
*     CALCULATE THE ORDINAL OF THE SMMAP ENTRY. 
# 
  
            MAP$ORD = MAXORD - Z - (Y * 16);
  
# 
*     GET THE SMMAP ENTRY AND CHECK THE RETURNED ERROR STATUS.
# 
  
            MGETENT(SM,MAP$ORD,SM$ADDR,FLAG); 
            IF FLAG NQ CMASTAT"NOERR" 
            THEN
              BEGIN  # CHECK FOR TYPE OF ERROR #
              IF FLAG EQ CMASTAT"CIOERR"
              THEN
                BEGIN 
                SSMSG$LINE[0] = " SMMAP PARITY ERROR."; 
                MESSAGE(SSMSG$BUF[0],SYSUDF1);
                RPCLOSE(OUT$FETP);
                RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT # 
                END 
  
              ELSE
                BEGIN 
                SSMSG$PROC[0] = PROCNAME; 
                MESSAGE(SSMSG[0],SYSUDF1);
                RPCLOSE(OUT$FETP);
                RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT # 
                END 
  
              END  # CHECK FOR TYPE OF ERROR #
  
# 
*     CHECK CARTRIDGE FLAGS AND SET THE APPROPRIATE CHARACTERS
*     INTO THE REPORT FLAG. 
# 
  
            RPTFLAG = "      "; 
            IF CM$FLAG1[0]
            THEN
              BEGIN 
              C<0,1>RPTFLAG = "E";
              END 
  
            IF CM$CODE[0] EQ CUBSTAT"CEUSE" 
            THEN                     # RESERVED FOR CUSTOMER ENGINEER # 
              BEGIN 
              C<1,1>RPTFLAG = "C";
              END 
  
            IF CM$CODE[0] EQ CUBSTAT"SCRPOOL" 
            THEN                     # ASSIGNED TO POOL # 
              BEGIN 
              C<2,1>RPTFLAG = "P";
              END 
  
            IF CM$CODE[0] EQ CUBSTAT"SYSUSE"
            THEN                     # RESERVED FOR SYSTEM USE #
              BEGIN 
              C<3,1>RPTFLAG = "S";
              END 
  
            IF CM$CODE[0] EQ CUBSTAT"NOCUBE"
            THEN                     # NO CUBICLE AT THIS ORDINAL # 
              BEGIN 
              C<4,1>RPTFLAG = "N";
              END 
  
            IF CM$FMLYNM[0] NQ USARG$FM[0]
            THEN                     # NOT IN THIS FAMILY # 
              BEGIN 
              C<5,1>RPTFLAG = "F";
              END 
  
            IF CM$CODE[0] EQ CUBSTAT"ALTCSU"
            THEN                     # RESERVED FOR OTHER SMMAP # 
              BEGIN 
              C<6,1>RPTFLAG = "R";
              END 
  
# 
*     CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE
*     REPORT FILE.
# 
  
            CHAR$10[0] = XCDD(Y); 
            RPLINE(OUT$FETP,CHAR$R2[0],5,2,1);
  
            CHAR$10[0] = XCDD(Z); 
            RPLINE(OUT$FETP,CHAR$R2[0],11,2,1); 
  
            CHAR$10[0] = CM$CCOD[0];
            BZFILL(CHAR,TYPFILL"BFILL",10); 
            RPLINE(OUT$FETP,CHAR$L2[0],17,2,1); 
  
            CHAR$10[0] = CM$CSND[0];
            BZFILL(CHAR,TYPFILL"BFILL",10); 
            RPLINE(OUT$FETP,CHAR$L8[0],19,8,1); 
  
            CHAR$10[0] = CM$FMLYNM[0];
            BZFILL(CHAR,TYPFILL"BFILL",10); 
            RPLINE(OUT$FETP,CHAR$L7[0],30,7,1); 
  
# 
*     DO NOT PRINT SUBFAMILY, GROUP, OR GROUP ORDINAL UNLESS THEY 
*     HAVE BEEN ASSIGNED. 
# 
  
            IF CM$CODE[0] EQ CUBSTAT"SUBFAM"
            THEN
              BEGIN   # ASSIGNED TO SUBFAMILY # 
              CHAR$10[0] = XCDD(CM$SUB[0]); 
              RPLINE(OUT$FETP,CHAR$R1[0],46,1,1); 
              IF CM$FCTORD[0] NQ 0
              THEN
                BEGIN 
                GP = CM$FCTORD[0] / MAXGRT; 
                CHAR$10[0] = XCDD(GP);
                RPLINE(OUT$FETP,CHAR$R2[0],57,2,1); 
                GRT = CM$FCTORD[0] - (GP * MAXGRT); 
                CHAR$10[0] = XCDD(GRT); 
                RPLINE(OUT$FETP,CHAR$R2[0],67,2,1); 
                END 
  
              END   # ASSIGNED TO SUBFAMILY # 
  
            RPLINE(OUT$FETP,RPTFLAG,74,7,0);
            END  # PROCESS EACH Y COORDINATE #
  
          END  # PROCESS EACH Z COORDINATE #
  
# 
*     CLOSE THE SMMAP.
# 
  
        MCLOSE(SM,FLAG);
        IF FLAG NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          SSMSG$PROC[0] = PROCNAME; 
          MESSAGE(SSMSG[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT); 
          END 
  
        END  # PROCESS EACH SM #
  
      RETURN; 
  
      END  # USRPTA # 
  
    TERM
PROC USRPTB;
# TITLE USRPTB - GENERATES OPTIONAL REPORT B.                         # 
  
      BEGIN  # USRPTB # 
  
# 
**    USRPTB - GENERATES OPTIONAL REPORT B. 
* 
*     THIS PROC IDENTIFIES THE AVAILABLE AU ON EACH CARTRIDGE, THE
*     NUMBER OF FLAGGED AU ON EACH CARTRIDGE, AND THE FLAGS SET 
*     FOR EACH CARTRIDGE IN THE SFMCATALOG. 
* 
*     PROC USRPTB.
* 
*     ENTRY.    (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES. 
*               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
*               (USARG$FM) = FAMILY NAME. 
* 
*     EXIT.     OPTIONAL REPORT B GENERATED.
* 
*     MESSAGES. 1)  FAMILY NOT FOUND. 
*               2)  UNABLE TO OPEN CATALOG. 
*               3)  SFMCATALOG PARITY ERROR.
*               4)  SSUSE ABNORMAL, USRPTB. 
* 
*     NOTES.    PROC *USRPTB* LISTS GENERAL STATUS INFORMATION FOR
*               EACH CARTRIDGE IN THE SFMCATALOG.  THE NUMBER OF
*               AVAILABLE AU AND FLAGGED AU FOR EACH CARTRIDGE, AND 
*               THE FLAGS SET FOR EACH CARTRIDGE ARE LISTED.
# 
  
# 
****  PROC USRPTB - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILLS CHARACTERS # 
        PROC CCLOSE;                 # CLOSES CATALOG # 
        PROC CGETFCT;                # GETS AN *FCT* ENTRY #
        PROC COPEN;                  # OPENS CATALOG #
        PROC CRDAST;                 # READS *AST* #
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RPCLOSE;                # CLOSES THE REPORT FILE # 
        PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
        PROC RPLINE;                 # WRITES LINE TO REPORT FILE # 
        PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE # 
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
        END 
  
# 
****  PROC USRPTB - XREF LIST END.
# 
  
      DEF PROCNAME #"USRPTB."#;      # PROC NAME #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBMCT 
*CALL COMBPFP 
*CALL COMSPFM 
*CALL COMXMSC 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM ACFLAG     I;             # AU CONFLICT COUNT #
      ITEM ASTADR     I;             # *AST* BUFFER ADDRESS # 
      ITEM FAFLAG     I;             # FLAWED,ALLOCATED AU COUNT #
      ITEM FCFLAG     I;             # FROZEN CHAIN AU COUNT #
      ITEM FCTADR     I;             # *FCT* BUFFER ADDRESS # 
      ITEM FLAG       I;             # ERROR FLAG # 
      ITEM FUFLAG     I;             # FLAWED,UNALLOCATED AU COUNT #
      ITEM GP         I;             # GROUP #
      ITEM GRT        I;             # GROUP ORDINAL #
      ITEM J          I;             # LOOP VARIABLE #
      ITEM LN$CNT     I;             # COUNT OF PRINTED LINES # 
      ITEM N          I;             # LOOP VARIABLE #
      ITEM RPTFLAG    C(6);          # REPORT FLAG #
      ITEM SFFLAG     I;             # START OF FRAGMENT AU COUNT # 
      ITEM SM         I;             # LOOP VARIABLE #
      ITEM SUBFAM     I;             # LOOP VARIABLE #
      ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
      ITEM TEMP$SM    C(1);          # SM CHARACTER # 
                                               CONTROL EJECT; 
  
      FCTADR = LOC(US$FCTENT[0]); 
      ASTADR = LOC(US$ASTENT[0]); 
  
# 
*     CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
# 
  
      TEMP$FAM = USARG$FM[0]; 
      BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  
# 
*     CHECK IF SUBFAMILY SELECTED.
# 
  
      SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF 
      DO
        BEGIN  # PROCESS EACH SUBFAMILY # 
        IF B<SUBFAM,1>SEL$SB EQ 0 
        THEN                         # SUBFAMILY NOT SELECTED # 
          BEGIN 
          TEST SUBFAM;
          END 
  
# 
*     SET THE FAMILY AND USER INDEX.
# 
  
        PFP$WRD0[0] = 0;
        PFP$FAM[0] = USARG$FM[0]; 
        PFP$UI[0] = DEF$UI + SUBFAM;
        PFP$FG1[0] = TRUE;
        PFP$FG4[0] = TRUE;
        SETPFP(PFP[0]); 
        IF PFP$STAT[0] NQ 0 
        THEN                         # FAMILY NOT FOUND # 
          BEGIN 
          SSMSG$LINE[0] = " FAMILY NOT FOUND."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
# 
*     OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS. 
# 
  
        CHAR$10[0] = XCDD(SUBFAM);
        SFMCAT$LST[0] = CHAR$R1[0]; 
        COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG); 
        IF FLAG EQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES # 
          END 
  
        IF FLAG NQ CMASTAT"NOERR" 
        THEN
          BEGIN  # CHECK FOR TYPE OF ERROR #
          IF FLAG EQ CMASTAT"INTLK"  ## 
            OR FLAG EQ CMASTAT"ATTERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG."; 
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          IF FLAG EQ CMASTAT"CIOERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT); 
            END 
  
          ELSE
            BEGIN 
            SSMSG$PROC[0] = PROCNAME; 
            MESSAGE(SSMSG[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          END  # CHECK FOR TYPE OF ERROR #
  
# 
*     CHECK IF SM ASSIGNED TO SUBFAMILY.
# 
  
        SLOWFOR SM = 1 STEP 1 UNTIL MAXSM 
        DO
          BEGIN  # CHECK EACH SELECTED SM # 
          IF B<SM,1>SEL$SM EQ 0 
          THEN                       # SM NOT SELECTED #
            BEGIN 
            TEST SM;
            END 
  
          P<PREAMBLE> = PRMBADR;
          LN$CNT = MAX$LN + 1;       # INITIALIZE LINE COUNT #
  
# 
*     IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM. 
# 
  
          IF PRM$SCW1[SM] EQ 0
          THEN                       # SM NOT ASSIGNED TO SUBFAMILY # 
            BEGIN 
            TEST SM;
            END 
  
# 
*     GET THE *AST* AND CHECK THE RETURNED ERROR STATUS.
# 
  
          CRDAST(USARG$FM[0],SUBFAM,SM,ASTADR,0,FLAG);
          IF FLAG NQ CMASTAT"NOERR" 
          THEN                       # UNABLE TO GET *AST* #
            BEGIN 
            SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          P<AST> = ASTADR;
  
# 
*     PROCESS ALL *AST* AND *FCT* ENTRIES.
# 
  
          SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
          DO
            BEGIN  # PROCESS AN *AST* AND *FCT* ENTRY # 
  
# 
*     GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
# 
  
            CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG); 
            IF FLAG NQ CMASTAT"NOERR" 
            THEN                     # UNABLE TO GET *FCT* #
              BEGIN 
              SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
              MESSAGE(SSMSG$BUF[0],SYSUDF1);
              RPCLOSE(OUT$FETP);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT # 
              END 
  
            P<FCT> = FCTADR;
  
# 
*     CHECK THE CUBICLE STATUS.  IF IT DOES NOT CONTAIN A 
*     CARTRIDGE GO TO NEXT CUBICLE. 
# 
  
            IF FCT$CSND[0] EQ "   " 
              OR FCT$CSNI[0] EQ 0 
            THEN                     # NO CARTRIDGE AT THIS LOCATION #
              BEGIN 
              TEST J; 
              END 
  
# 
*     WRITE HEADER TO REPORT FILE IF NEW PAGE.
# 
  
            IF LN$CNT GQ MAX$LN 
            THEN                     # PAGE EJECT AND PRINT HEADER #
              BEGIN 
              TEMP$SM = SM; 
              RPEJECT(OUT$FETP);
              RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT B - ",5,26,1); 
              RPLINE(OUT$FETP,"CARTRIDGE SUMMARY REPORT",31,24,1);
              RPLINE(OUT$FETP,"SM = ",58,5,1);
              RPLINE(OUT$FETP,TEMP$SM,63,1,1);
              RPLINE(OUT$FETP,"SUBFAMILY = ",67,12,1);
              CHAR$10[0] = XCDD(SUBFAM);
              RPLINE(OUT$FETP,CHAR$R1[0],79,1,1); 
              RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
              RPLINE(OUT$FETP,TEMP$FAM,93,7,0); 
              RPSPACE(OUT$FETP,SP"SPACE",1);
  
# 
*     PRINT NOTES AND COLUMN HEADINGS.
# 
  
              RPLINE(OUT$FETP,"NOTES:",5,6,1);
              RPLINE(OUT$FETP,"CARTRIDGE FLAGS:",46,16,0);
              RPLINE(OUT$FETP,"FA = FLAWED AND ALLOCATED",7,25,1);
              RPLINE(OUT$FETP,"M = MISSING",48,11,0); 
              RPLINE(OUT$FETP,"FU = FLAWED AND UNALLOCATED",7,27,1);
              RPLINE(OUT$FETP,"I = INHIBIT",48,11,0); 
              RPLINE(OUT$FETP,"SF = START OF FRAGMENT",7,22,1); 
              RPLINE(OUT$FETP,"F = FREE CARTRIDGE",48,18,0);
              RPLINE(OUT$FETP,"FC = FROZEN CHAIN",7,17,1);
              RPLINE(OUT$FETP,"L = LINK(FREE AU EXIST, ",48,24,1);
              RPLINE(OUT$FETP,"NO OFF CARTRIDGE LINK)",72,22,0);
              RPLINE(OUT$FETP,"AC = AU CONFLICT",7,16,1); 
              RPLINE(OUT$FETP,"P = EXCESSIVE WRITE ERRORS",48,26,0);
              RPLINE(OUT$FETP,"GPORD = ORDINAL IN GROUP",7,24,1); 
              RPLINE(OUT$FETP,"E = MAP ERROR",48,13,1); 
              RPLINE(OUT$FETP,"(DETECTED BY SSVAL)",61,19,0); 
              RPSPACE(OUT$FETP,SP"SPACE",1);
              RPLINE(OUT$FETP,"------ERROR CONDITIONS------",60,28,0);
              RPLINE(OUT$FETP,"FREE AU      CART",39,17,1); 
              RPLINE(OUT$FETP,"--------NUMBER OF AU--------",60,28,0);
              RPLINE(OUT$FETP,"GP  GPORD   Y",5,13,1);
              RPLINE(OUT$FETP,"Z   CM  CSN",21,11,1); 
              RPLINE(OUT$FETP,"SMALL   LARGE   FLAGS",36,21,1); 
              RPLINE(OUT$FETP,"FA    FU    SF",62,14,1);
              RPLINE(OUT$FETP,"FC    AC",80,8,0); 
              RPSPACE(OUT$FETP,SP"SPACE",1);
              LN$CNT = 17;
              END 
  
# 
*     CHECK FOR FLAGS AND SET THE APPROPRIATE CHARACTERS INTO THE 
*     REPORT FLAG.
# 
  
            RPTFLAG = "      "; 
            IF FCT$LCF[0] 
            THEN                     # CARTRIDGE MISSING #
              BEGIN 
              C<1,1>RPTFLAG = "M";
              END 
  
            IF FCT$IAF[0] 
            THEN                     # INHIBIT ALLOCATION # 
              BEGIN 
              C<2,1>RPTFLAG = "I";
              END 
  
            IF FCT$FCF[0] 
            THEN                     # FREE CARTRIDGE # 
              BEGIN 
              C<3,1>RPTFLAG = "F";
              END 
  
            IF AST$AULF[J] GR 0      ## 
              OR AST$AUSF[J] GR 0 
            THEN                     # FREE AU EXIST #
              BEGIN 
              IF FCT$OCLF[0] EQ 7 
              THEN                   # NO LINKS AVAILABLE # 
                BEGIN 
                C<4,1>RPTFLAG = "L";
                END 
  
              END 
  
            IF FCT$EEF[0] 
            THEN                     # EXCESSIVE PARITY ERRORS #
              BEGIN 
              C<5,1>RPTFLAG = "P";
              END 
  
            IF FCT$SEF[0] 
            THEN                     # SMMAP ERROR FLAG SET # 
              BEGIN 
              C<0,1>RPTFLAG = "E";
              END 
  
# 
*     PROCESS EACH AU.  CHECK FOR ERRORS AND UPDATE THE APPROPRIATE 
*     COUNTERS. 
# 
  
            ACFLAG = 0; 
            FAFLAG = 0; 
            FCFLAG = 0; 
            FUFLAG = 0; 
            SFFLAG = 0; 
  
            SLOWFOR N = 1 STEP 1 UNTIL INAVOT 
            DO
              BEGIN  # PROCESS EACH AU #
  
              SETFCTX(N);            # SET *FWD* AND *FPS* VALUES # 
  
              IF FCT$FAUF(FWD,FPS) NQ 0 
              THEN                   # FLAWED AU #
                BEGIN 
                IF FCT$FBF(FWD,FPS) EQ 0
                THEN                 # FLAWED AND UNALLOCATED # 
                  BEGIN 
                  FUFLAG = FUFLAG + 1;
                  END 
  
                ELSE                 # FLAWED AND ALLOCATED # 
                  BEGIN 
                  FAFLAG = FAFLAG + 1;
                  END 
  
                END 
  
              IF FCT$SFF(FWD,FPS) NQ 0
              THEN
                BEGIN 
                SFFLAG = SFFLAG + 1;  # START OF FRAGMENT # 
                END 
  
              IF FCT$FRCF(FWD,FPS) NQ 0 
              THEN
                BEGIN 
                FCFLAG = FCFLAG + 1;  # FROZEN CHAIN #
                END 
  
              IF FCT$AUCF(FWD,FPS) NQ 0 
              THEN
                BEGIN 
                ACFLAG = ACFLAG + 1;  # AU CONFLICT # 
                END 
  
              END  # PROCESS EACH AU #
  
# 
*     CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE REPORT 
*     FILE.  BLANK FILL CSN AND CARTRIDGE MANUFACTURER CODE.
# 
  
            GP = J / MAXGRT;
            CHAR$10[0] = XCDD(GP);
            RPLINE(OUT$FETP,CHAR$R2[0],5,2,1);
  
            GRT = J - (GP * MAXGRT);
            CHAR$10[0] = XCDD(GRT); 
            RPLINE(OUT$FETP,CHAR$R2[0],10,2,1); 
  
            CHAR$10[0] = XCDD(FCT$Y[0]);
            RPLINE(OUT$FETP,CHAR$R2[0],16,2,1); 
  
            CHAR$10[0] = XCDD(FCT$Z[0]);
            RPLINE(OUT$FETP,CHAR$R2[0],20,2,1); 
  
            CHAR$10[0] = FCT$CCOD[0]; 
            BZFILL(CHAR,TYPFILL"BFILL",10); 
            RPLINE(OUT$FETP,CHAR$L2[0],25,2,1); 
  
            CHAR$10[0] = FCT$CSND[0]; 
            BZFILL(CHAR,TYPFILL"BFILL",10); 
            RPLINE(OUT$FETP,CHAR$L8[0],27,8,1); 
  
            CHAR$10[0] = XCDD(AST$AUSF[J]); 
            RPLINE(OUT$FETP,CHAR$R4[0],37,4,1); 
  
            CHAR$10[0] = XCDD(AST$AULF[J]); 
            RPLINE(OUT$FETP,CHAR$R4[0],44,4,1); 
  
            RPLINE(OUT$FETP,RPTFLAG,51,6,1);
  
            CHAR$10[0] = XCDD(FAFLAG);
            RPLINE(OUT$FETP,CHAR$R4[0],60,4,1); 
  
            CHAR$10[0] = XCDD(FUFLAG);
            RPLINE(OUT$FETP,CHAR$R4[0],66,4,1); 
  
            CHAR$10[0] = XCDD(SFFLAG);
            RPLINE(OUT$FETP,CHAR$R4[0],72,4,1); 
  
            CHAR$10[0] = XCDD(FCFLAG);
            RPLINE(OUT$FETP,CHAR$R4[0],78,4,1); 
  
            CHAR$10[0] = XCDD(ACFLAG);
            RPLINE(OUT$FETP,CHAR$R4[0],84,4,0); 
            LN$CNT = LN$CNT + 1;     # INCREMENT LINE COUNT # 
  
            END  # PROCESS AN *AST* AND *FCT* ENTRY # 
  
          END  # CHECK EACH SELECTED SM # 
  
# 
*     CLOSE THE CATALOG.
# 
  
        CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
        IF FLAG NQ CMASTAT"NOERR" 
        THEN                         # UNABLE TO CLOSE CATALOG #
          BEGIN 
          SSMSG$PROC[0] = PROCNAME; 
          MESSAGE(SSMSG[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER # 
  
        END  # PROCESS EACH SUBFAMILY # 
  
      RETURN; 
  
      END  # USRPTB # 
  
    TERM
PROC USRPTC;
# TITLE USRPTC - GENERATES OPTIONAL REPORT C.                         # 
  
      BEGIN  # USRPTC # 
  
# 
**    USRPTC - GENERATES OPTIONAL REPORT C. 
* 
*     THIS PROC LISTS CARTRIDGE USAGE INFORMATION FOR EACH ENTRY
*     IN THE SFMCATALOG.
* 
*     PROC USRPTC.
* 
*     ENTRY.    (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES. 
*               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
*               (USARG$FM) = FAMILY NAME. 
* 
*     EXIT.     OPTIONAL REPORT C GENERATED.
* 
*     MESSAGES. 1)  FAMILY NOT FOUND. 
*               2)  UNABLE TO OPEN CATALOG. 
*               3)  SFMCATALOG PARITY ERROR.
*               4)  SSUSE ABNORMAL, USRPTC. 
# 
  
# 
****  PROC USRPTC - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILLS CHARACTERS # 
        PROC CCLOSE;                 # CLOSES CATALOG # 
        PROC CGETFCT;                # GETS AN *FCT* ENTRY #
        PROC COPEN;                  # OPENS CATALOG #
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RPCLOSE;                # CLOSES THE REPORT FILE # 
        PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
        PROC RPLINE;                 # WRITES LINE TO REPORT FILE # 
        PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE # 
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
        END 
  
# 
****  PROC USRPTC - XREF LIST END.
# 
  
      DEF PROCNAME #"USRPTC."#;      # PROC NAME #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBMCT 
*CALL COMBPFP 
*CALL COMSPFM 
*CALL COMXMSC 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM FCTADR     I;             # *FCT* BUFFER ADDRESS # 
      ITEM FLAG       I;             # ERROR FLAG # 
      ITEM GP         I;             # GROUP #
      ITEM J          I;             # LOOP VARIABLE #
      ITEM LN$CNT     I;             # COUNT OF PRINTED LINES # 
      ITEM OCL        I;             # AVAILABLE LINK COUNT # 
      ITEM RPTFLAG    C(4);          # REPORT FLAG #
      ITEM SM         I;             # LOOP VARIABLE #
      ITEM SUBFAM     I;             # LOOP VARIABLE #
      ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
      ITEM TEMP$SM    C(1);          # SM CHARACTER # 
  
                                               CONTROL EJECT; 
  
      FCTADR = LOC(US$FCTENT[0]); 
  
# 
*     CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
# 
  
      TEMP$FAM = USARG$FM[0]; 
      BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  
# 
*     CHECK IF SUBFAMILY SELECTED.
# 
  
      SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF 
      DO
        BEGIN  # PROCESS EACH SUBFAMILY # 
        IF B<SUBFAM,1>SEL$SB EQ 0 
        THEN                         # SUBFAMILY NOT SELECTED # 
          BEGIN 
          TEST SUBFAM;
          END 
  
# 
*     SET THE FAMILY AND USER INDEX.
# 
  
        PFP$WRD0[0] = 0;
        PFP$FAM[0] = USARG$FM[0]; 
        PFP$UI[0] = DEF$UI + SUBFAM;
        PFP$FG1[0] = TRUE;
        PFP$FG4[0] = TRUE;
        SETPFP(PFP[0]); 
        IF PFP$STAT[0] NQ 0 
        THEN                         # FAMILY NOT FOUND # 
          BEGIN 
          SSMSG$LINE[0] = " FAMILY NOT FOUND."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
# 
*     OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS. 
# 
  
        CHAR$10[0] = XCDD(SUBFAM);
        SFMCAT$LST[0] = CHAR$R1[0]; 
        COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG); 
        IF FLAG EQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES # 
          END 
  
        IF FLAG NQ CMASTAT"NOERR" 
        THEN
          BEGIN  # CHECK FOR TYPE OF ERROR #
          IF FLAG EQ CMASTAT"INTLK"  ## 
            OR FLAG EQ CMASTAT"ATTERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG."; 
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          IF FLAG EQ CMASTAT"CIOERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT); 
            END 
  
          ELSE
            BEGIN 
            SSMSG$PROC[0] = PROCNAME; 
            MESSAGE(SSMSG[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          END  # CHECK FOR TYPE OF ERROR #
  
# 
*     CHECK IF SM ASSIGNED TO SUBFAMILY.
# 
  
        SLOWFOR SM = 1 STEP 1 UNTIL MAXSM 
        DO
          BEGIN  # CHECK EACH SELECTED SM # 
          IF B<SM,1>SEL$SM EQ 0 
          THEN                       # SM NOT SELECTED #
            BEGIN 
            TEST SM;
            END 
  
          P<PREAMBLE> = PRMBADR;
          TEMP$SM = SM; 
          LN$CNT = MAX$LN + 1;       # INITIALIZE LINE COUNT #
  
# 
*     IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM. 
# 
  
          IF PRM$SCW1[SM] EQ 0
          THEN                       # SM NOT ASSIGNED TO SUBFAMILY # 
            BEGIN 
            TEST SM;
            END 
  
# 
*     PROCESS ALL *FCT* ENTRIES.
# 
  
          SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
          DO
            BEGIN  # PROCESS AN *FCT* ENTRY # 
  
# 
*     GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
# 
  
            CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG); 
            IF FLAG NQ CMASTAT"NOERR" 
            THEN                     # UNABLE TO GET *FCT* #
              BEGIN 
              SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
              MESSAGE(SSMSG$BUF[0],SYSUDF1);
              RPCLOSE(OUT$FETP);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT # 
              END 
  
            P<FCT> = FCTADR;
  
# 
*     CHECK THE CUBICLE STATUS.  IF IT DOES NOT CONTAIN A 
*     CARTRIDGE GO TO NEXT CUBICLE. 
# 
  
            IF FCT$CSND[0] EQ "   " 
              OR FCT$CSNI[0] EQ 0 
            THEN                     # NO CARTRIDGE AT THIS LOCATION #
              BEGIN 
              TEST J; 
              END 
  
# 
*     WRITE HEADER TO REPORT FILE IF NEW PAGE.
# 
  
            IF LN$CNT GQ MAX$LN 
            THEN                     # PAGE EJECT AND PRINT HEADER #
              BEGIN 
              RPEJECT(OUT$FETP);
              RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT C - ",5,26,1); 
              RPLINE(OUT$FETP,"DETAILED CARTRIDGE REPORT",31,25,1); 
              RPLINE(OUT$FETP,"SM = ",58,5,1);
              RPLINE(OUT$FETP,TEMP$SM,63,1,1);
              RPLINE(OUT$FETP,"SUBFAMILY = ",67,12,1);
              CHAR$10[0] = XCDD(SUBFAM);
              RPLINE(OUT$FETP,CHAR$R1[0],79,1,1); 
              RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
              RPLINE(OUT$FETP,TEMP$FAM,93,7,0); 
              RPSPACE(OUT$FETP,SP"SPACE",1);
  
# 
*     PRINT NOTES AND COLUMN HEADINGS.
# 
  
              RPLINE(OUT$FETP,"FLAGS:",5,6,1);
              RPLINE(OUT$FETP,"I = INHIBIT ALLOCATION",15,22,1);
              RPLINE(OUT$FETP,"M = MISSING",49,12,1); 
              RPLINE(OUT$FETP,"P = EXCESSIVE PARITY ERRORS",81,27,0); 
              RPLINE(OUT$FETP,"E = MAP ERROR",15,13,1); 
              RPLINE(OUT$FETP,"OCL = AVAILABLE LINK COUNT",49,26,1);
              RPLINE(OUT$FETP,"FCTORD = SFM CATALOG ORDINAL",81,28,0);
              RPSPACE(OUT$FETP,SP"SPACE",1);
              RPLINE(OUT$FETP,"------AU------      CARTRIDGE",55,29,0); 
              RPLINE(OUT$FETP," Y   Z    CM  CSN",2,17,1);
              RPLINE(OUT$FETP,"GROUP    FCTORD   FLAGS",26,23,1); 
              RPLINE(OUT$FETP,"FIRST    FIRST       DIVISION",55,29,1); 
              RPLINE(OUT$FETP,"OCL",88,3,0);
              RPLINE(OUT$FETP,"SMALL    LARGE        POINT",55,27,0); 
              LN$CNT = 11;
              END 
  
# 
*     CHECK FOR FLAGS AND SET THE APPROPRIATE CHARACTERS INTO THE 
*     REPORT FLAG.
# 
  
            RPTFLAG = "    "; 
            IF FCT$IAF[0] 
            THEN                     # INHIBIT ALLOCATION FLAG SET #
              BEGIN 
              C<1,1>RPTFLAG = "I";
              END 
  
            IF FCT$LCF[0] 
            THEN                     # CARTRIDGE MISSING #
              BEGIN 
              C<2,1>RPTFLAG = "M";
              END 
  
            IF FCT$EEF[0] 
            THEN                     # EXCESSIVE ERROR FLAG SET # 
              BEGIN 
              C<3,1>RPTFLAG = "P";
              END 
  
            IF FCT$SEF[0] 
            THEN                     # SMMAP ERROR FLAG SET # 
              BEGIN 
              C<0,1>RPTFLAG = "E";
              END 
  
# 
*     COUNT AVAILABLE OFF CARTRIDGE LINKS.
# 
  
            OCL = 0;
            IF B<0,1>FCT$OCLF[0] EQ 0 
            THEN
              BEGIN 
              OCL = OCL + 1;
              END 
  
            IF B<1,1>FCT$OCLF[0] EQ 0 
            THEN
              BEGIN 
              OCL = OCL + 1;
              END 
  
            IF B<2,1>FCT$OCLF[0] EQ 0 
            THEN
              BEGIN 
              OCL = OCL + 1;
              END 
  
# 
*     CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE REPORT 
*     FILE. 
# 
  
            CHAR$10[0] = XCDD(FCT$Y[0]);
            RPLINE(OUT$FETP,CHAR$R2[0],2,2,1);
  
            CHAR$10[0] = XCDD(FCT$Z[0]);
            RPLINE(OUT$FETP,CHAR$R2[0],6,2,1);
  
            CHAR$10[0] = FCT$CCOD[0]; 
            BZFILL(CHAR,TYPFILL"BFILL",10); 
            RPLINE(OUT$FETP,CHAR$L2[0],12,2,1); 
  
            CHAR$10[0] = FCT$CSND[0]; 
            BZFILL(CHAR,TYPFILL"BFILL",10); 
            RPLINE(OUT$FETP,CHAR$L8[0],14,8,1); 
  
            GP = J / MAXGRT;
            CHAR$10[0] = XCDD(GP);
            RPLINE(OUT$FETP,CHAR$R2[0],27,2,1); 
  
            CHAR$10[0] = XCDD(J); 
            RPLINE(OUT$FETP,CHAR$R3[0],36,3,1); 
  
            RPLINE(OUT$FETP,RPTFLAG,44,4,1);
  
            CHAR$10[0] = XCDD(FCT$FAUSF[0]);
            RPLINE(OUT$FETP,CHAR$R4[0],55,4,1); 
  
            CHAR$10[0] = XCDD(FCT$FAULF[0]);
            RPLINE(OUT$FETP,CHAR$R4[0],64,4,1); 
  
            CHAR$10[0] = XCDD(FCT$CDP[0]);
            RPLINE(OUT$FETP,CHAR$R4[0],77,4,1); 
  
            CHAR$10[0] = XCDD(OCL); 
            RPLINE(OUT$FETP,CHAR$R2[0],88,2,0); 
  
            LN$CNT = LN$CNT + 1;     # INCREMENT LINE COUNT # 
            END  # PROCESS AN *FCT* ENTRY # 
  
          END  # CHECK EACH SELECTED SM # 
  
# 
*     CLOSE THE CATALOG.
# 
  
        CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
        IF FLAG NQ CMASTAT"NOERR" 
        THEN                         # UNABLE TO CLOSE CATALOG #
          BEGIN 
          SSMSG$PROC[0] = PROCNAME; 
          MESSAGE(SSMSG[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT # 
          END 
  
        ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER # 
  
        END  # PROCESS EACH SUBFAMILY # 
  
      RETURN; 
  
      END  # USRPTC # 
  
    TERM
PROC USRPTD;
# TITLE USRPTD - GENERATES OPTIONAL REPORT D.                         # 
  
      BEGIN  # USRPTD # 
  
# 
**    USRPTD - GENERATES OPTIONAL REPORT D. 
* 
*     THIS PROC LISTS DETAILED AU STATUS INFORMATION FOR EACH 
*     ENTRY IN THE SFMCATALOG PLUS CARTRIDGE USAGE INFORMATION. 
* 
*     PROC USRPTD.
* 
*     ENTRY.    (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES. 
*               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
*               (USARG$FM) = FAMILY NAME. 
* 
*     EXIT.     OPTIONAL REPORT D GENERATED.
* 
*     MESSAGES. 1)  FAMILY NOT FOUND. 
*               2)  UNABLE TO OPEN CATALOG. 
*               3)  SFMCATALOG PARITY ERROR.
*               4)  SSUSE ABNORMAL, USRPTD. 
*               5)  CARTRIDGE NOT FOUND.
* 
*     NOTES.    FOR EACH SELECTED SUBFAMILY, PROC *USRPTD* OPENS THE
*               SFM CATALOG AND SEARCHES FOR THE CARTRIDGE WITH THE 
*               SELECTED *CSN* AND *CM*.  WHEN THE CARTRIDGE IS FOUND 
*               THE CARTRIDGE LINK FIELD OF THE *FCT* ENTRY IS
*               PRINTED IN OCTAL FOR EACH AU.  IF THE CARTRIDGE 
*               IS NOT FOUND A MESSAGE IS ISSUED TO THE DAYFILE 
*               AND *SSUSE* ABORTS. 
# 
  
# 
****  PROC USRPTD - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK FILLS CHARACTERS # 
        PROC CCLOSE;                 # CLOSES CATALOG # 
        PROC CGETFCT;                # GETS AN *FCT* ENTRY #
        PROC COPEN;                  # OPENS CATALOG #
        PROC CRDAST;                 # READ *AST* # 
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RPCLOSE;                # CLOSES THE REPORT FILE # 
        PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
        PROC RPLINE;                 # WRITES LINE TO REPORT FILE # 
        PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE # 
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
        FUNC XCOD  C(10);            # CONVERTS OCTAL TO DISPLAY #
        PROC XWOD;                   # CONVERT OCTAL TO DISPLAY # 
        END 
  
# 
****  PROC USRPTD - XREF LIST END.
# 
  
      DEF PROCNAME #"USRPTD."#;      # PROC NAME #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBMCT 
*CALL COMBPFP 
*CALL COMSPFM 
*CALL COMXMSC 
*CALL COMTLAB 
*CALL COMTOUT 
*CALL COMTUSE 
*CALL COMTUSP 
  
      ITEM ASTADR     I;             # *AST* BUFFER ADDRESS # 
      ITEM CODE       C(2);          # CODE FIELD FOR OUTPUT #
      ITEM COLUMN     I;             # COLUMN POSITION FOR OUTPUT # 
      ITEM ER$CODE    C(1);          # CODE FIELD FOR OUTPUT #
      ITEM FCTADR     I;             # *FCT* BUFFER ADDRESS # 
      ITEM FLAG       I;             # ERROR FLAG # 
      ITEM GP         I;             # GROUP #
      ITEM FOUND      B;             # CSN FOUND FLAG # 
      ITEM I          I;             # LOOP VARIABLE #
      ITEM J          I;             # LOOP VARIABLE #
      ITEM LN$CNT     I;             # COUNT OF PRINTED LINES # 
      ITEM N          I;             # LOOP VARIABLE #
      ITEM NUM        C(10);         # AU NUMBER #
      ITEM SM         I;             # LOOP VARIABLE #
      ITEM SUBFAM     I;             # LOOP VARIABLE #
      ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
      ITEM TEMP$SM    C(1);          # TEMPORARY CHARACTER #
  
      ARRAY DIS[0:0] P(2);
        BEGIN 
        ITEM DIS$CLFG   C(01,00,10);  # LINK FIELD IN DISPLAY CODE #
        END 
  
                                               CONTROL EJECT; 
  
      ASTADR = LOC(US$ASTENT[0]); 
      FCTADR = LOC(US$FCTENT[0]); 
      SEL$CSN = USARG$CN[0];
      FOUND = FALSE;
  
      IF USARG$CM[0] EQ 0 
      THEN                           # USE DEFAULT MANUFACTURER # 
        BEGIN 
        SEL$CM = IBMCART; 
        END 
  
      ELSE                           # USE SPECIFIED MANUFACTURER # 
        BEGIN 
        SEL$CM = USARG$CM[0]; 
        END 
  
# 
*     CHANGE ZERO FILL TO SPACE FILL FOR FAMILY AND CARTRIDGE-ID. 
# 
  
      TEMP$FAM = USARG$FM[0]; 
      BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
      BZFILL(SEL$CM,TYPFILL"BFILL",2);
      BZFILL(SEL$CSN,TYPFILL"BFILL",8); 
  
# 
*     CHECK IF SUBFAMILY SELECTED.
# 
  
      SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF 
      DO
        BEGIN  # PROCESS EACH SUBFAMILY # 
        IF B<SUBFAM,1>SEL$SB EQ 0 
        THEN                         # SUBFAMILY NOT SELECTED # 
          BEGIN 
          TEST SUBFAM;
          END 
  
# 
*     SET THE FAMILY AND USER INDEX.
# 
  
        PFP$WRD0[0] = 0;
        PFP$FAM[0] = USARG$FM[0]; 
        PFP$UI[0] = DEF$UI + SUBFAM;
        PFP$FG1[0] = TRUE;
        PFP$FG4[0] = TRUE;
        SETPFP(PFP[0]); 
        IF PFP$STAT[0] NQ 0 
        THEN                         # FAMILY NOT FOUND # 
          BEGIN 
          SSMSG$LINE[0] = " FAMILY NOT FOUND."; 
          MESSAGE(SSMSG$BUF[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT); 
          END 
  
# 
*     OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS. 
# 
  
        CHAR$10 = XCDD(SUBFAM); 
        SFMCAT$LST[0] = CHAR$R1[0]; 
        RPLINE(OUT$FETP,CHAR$R3[0],8,3,1);
        COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG); 
        IF FLAG EQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES # 
          END 
  
        IF FLAG NQ CMASTAT"NOERR" 
        THEN
          BEGIN  # CHECK FOR TYPE OF ERROR #
          IF FLAG EQ CMASTAT"INTLK"  ## 
            OR FLAG EQ CMASTAT"ATTERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT); 
            END 
  
          IF FLAG EQ CMASTAT"CIOERR"
          THEN
            BEGIN 
            SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT); 
            END 
  
          ELSE
            BEGIN 
            SSMSG$PROC[0] = PROCNAME; 
            MESSAGE(SSMSG[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT); 
            END 
  
          END  # CHECK FOR TYPE OF ERROR #
  
# 
*     CHECK IF SM ASSIGNED TO SUBFAMILY.
# 
  
        SLOWFOR SM = 1 STEP 1 UNTIL MAXSM 
        DO
          BEGIN  # CHECK EACH SELECTED SM # 
          IF B<SM,1>SEL$SM EQ 0 
          THEN                       # SM NOT SELECTED #
            BEGIN 
            TEST SM;
            END 
  
          P<PREAMBLE> = PRMBADR;
          TEMP$SM = SM; 
          LN$CNT = MAX$LN + 1;       # INITIALIZE LINE COUNT #
  
# 
*     IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM. 
# 
  
          IF PRM$SCW1[SM] EQ 0
          THEN                       # SM NOT ASSIGNED TO SUBFAMILY # 
            BEGIN 
            TEST SM;
            END 
  
# 
*     READ THE *AST* AND CHECK THE RETURNED ERROR STATUS. 
# 
  
          CRDAST(USARG$FM[0],SUBFAM,SM,ASTADR,0,FLAG);
          IF FLAG NQ CMASTAT"NOERR" 
          THEN                       # UNABLE TO GET *AST* #
            BEGIN 
            SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
            MESSAGE(SSMSG$BUF[0],SYSUDF1);
            RPCLOSE(OUT$FETP);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT # 
            END 
  
          P<AST> = ASTADR;
  
# 
*     PROCESS ALL *FCT* ENTRIES.
# 
  
          SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
          DO
            BEGIN  # PROCESS AN *FCT* ENTRY # 
  
# 
*     GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
# 
  
            CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG); 
            IF FLAG NQ CMASTAT"NOERR" 
            THEN                     # UNABLE TO GET *FCT* #
              BEGIN 
              SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
              MESSAGE(SSMSG$BUF[0],SYSUDF1);
              RPCLOSE(OUT$FETP);
              RESTPFP(PFP$ABORT); 
              END 
  
            P<FCT> = FCTADR;
  
# 
*     CHECK THE CSN OF THE CARTRIDGE IN THIS CUBICLE.  IF IT IS 
*     NOT THE SELECTED CSN, GET THE NEXT ENTRY. 
# 
  
            IF FCT$CSND[0] NQ SEL$CSN 
            THEN
              BEGIN 
              TEST J; 
              END 
  
# 
*     IF THE CARTRIDGE MANUFACTURER IS DIFFERENT FROM THE SELECTED
*     MANUFACTURER, GET THE NEXT ENTRY. 
# 
  
            IF SEL$CM NQ FCT$CCOD[0]
            THEN
              BEGIN 
              TEST J; 
              END 
  
            FOUND = TRUE; 
  
# 
*     PROCESS EACH AU.
# 
  
            SLOWFOR N = 0 STEP 8 UNTIL INAVOT 
            DO
              BEGIN  # PROCESS EACH AU #
  
# 
*     WRITE HEADER TO REPORT FILE IF NEW PAGE.
# 
  
              IF LN$CNT GQ MAX$LN 
              THEN
                BEGIN  # PAGE EJECT AND PRINT HEADER #
                RPEJECT(OUT$FETP);
                RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT D - ",5,26,1); 
                RPLINE(OUT$FETP,"DETAILED AU STATUS REPORT",31,25,1); 
                RPLINE(OUT$FETP,"SM = ",59,5,1);
                RPLINE(OUT$FETP,TEMP$SM,64,1,1);
                CHAR$10[0] = XCOD(SUBFAM);
                RPLINE(OUT$FETP,"SUBFAMILY = ",68,12,1);
                RPLINE(OUT$FETP,CHAR$R1[0],80,1,1); 
                RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
                RPLINE(OUT$FETP,TEMP$FAM,93,7,0); 
                RPSPACE(OUT$FETP,SP"SPACE",1);
                RPLINE(OUT$FETP,"F = FLAWED AU ",9,14,1); 
                RPLINE(OUT$FETP,"(DEMARK FAILURE)",23,16,0);
                RPLINE(OUT$FETP,"V = START OF VOLUME",9,19,0);
                RPLINE(OUT$FETP,"E = ONE OF THE ERROR FLAGS",9,26,1); 
                RPLINE(OUT$FETP," SET (AU CONFLICT, FROZEN ",35,26,1);
                RPLINE(OUT$FETP,"CHAIN, START OF FRAGMENT)",61,25,0); 
                RPSPACE(OUT$FETP,SP"SPACE",1);
                RPLINE(OUT$FETP,"FCTORD     Y     Z",5,18,1); 
                RPLINE(OUT$FETP,"CM  CSN        GROUP",30,20,0);
  
                CHAR$10[0] = XCDD(J); 
                RPLINE(OUT$FETP,CHAR$R3[0],5,3,1);
  
                CHAR$10[0] = XCDD(FCT$Y[0]);
                RPLINE(OUT$FETP,CHAR$R2[0],15,2,1); 
  
                CHAR$10[0] = XCDD(FCT$Z[0]);
                RPLINE(OUT$FETP,CHAR$R2[0],21,2,1); 
  
                CHAR$10[0] = FCT$CCOD[0]; 
                BZFILL(CHAR,TYPFILL"BFILL",2);
                RPLINE(OUT$FETP,CHAR$L2[0],30,2,1); 
  
                CHAR$10[0] = FCT$CSND[0]; 
                BZFILL(CHAR,TYPFILL"BFILL",10); 
                RPLINE(OUT$FETP,CHAR$L8[0],32,8,1); 
  
                GP = J / MAXGRT;
                CHAR$10[0] = XCDD(GP);
                RPLINE(OUT$FETP,CHAR$R2[0],46,2,1); 
  
                IF (AST$AUSF[J] + AST$AULF[J] + AST$FLAWS[J]) EQ INAVOT 
                THEN
                  BEGIN 
                  RPLINE(OUT$FETP,"*** EMPTY CARTRIDGE ***",55,23,0); 
                  END 
  
                ELSE
                  BEGIN 
                  RPLINE(OUT$FETP," ",55,1,0);
                  END 
  
                RPSPACE(OUT$FETP,SP"SPACE",1);
                RPLINE(OUT$FETP,"AU         XXX0",6,15,1);
                RPLINE(OUT$FETP,"XXX1           XXX2",32,19,1); 
                RPLINE(OUT$FETP,"XXX3           XXX4",62,19,1); 
                RPLINE(OUT$FETP,"XXX5           XXX6",92,19,1); 
                RPLINE(OUT$FETP,"XXX7",122,4,0);
                LN$CNT = 13;
                END  # PAGE EJECT AND PRINT HEADER #
  
              NUM = XCOD(N);
              RPLINE(OUT$FETP,C<6,3>NUM,5,3,1); 
              RPLINE(OUT$FETP,"X",8,1,1); 
              COLUMN = 12;
  
              SLOWFOR I = N STEP 1 UNTIL N + 7
              DO
                BEGIN  # PRINT EIGHT AU ON A LINE # 
  
# 
*     DO NOT CONTINUE IF ALL AU-S HAVE BEEN REPORTED. 
# 
  
                IF I GR INAVOT
                THEN
                  BEGIN 
                  RPLINE(OUT$FETP," ",135,1,0);  # PRINT LINE # 
                  TEST N; 
                  END 
  
# 
*     DO NOT REPORT ON AU ZERO. 
# 
  
                IF N EQ 0 AND I EQ 0
                THEN
                  BEGIN 
                  COLUMN = COLUMN + 15; 
                  TEST I; 
                  END 
  
                ER$CODE = " ";
                CODE = "  ";
                SETFCTX(I);          # SET *FWD* AND *FPS* VALUES # 
  
# 
*     CHECK EACH AU FOR FLAGS.
# 
  
                IF FCT$AUCF(FWD,FPS) NQ 0  ## 
                  OR FCT$FRCF(FWD,FPS) NQ 0  ## 
                  OR FCT$SFF(FWD,FPS) NQ 0
                THEN                 # ONE OF THE ERROR FLAGS SET # 
                  BEGIN 
                  ER$CODE = "E";
                  END 
  
                IF FCT$FAUF(FWD,FPS) NQ 0 
                THEN                 # FLAWED AU #
                  BEGIN 
                  CODE = " F";
                  END 
  
                IF FCT$CAUF(FWD,FPS) EQ 0 
                THEN                 # START OF VOLUME #
                  BEGIN 
                  CODE = " V";
                  END 
  
                IF FCT$FAUF(FWD,FPS) NQ 0  ## 
                  AND FCT$CAUF(FWD,FPS) EQ 0
                THEN                 # FLAWED AU AND START OF VOLUME #
                  BEGIN 
                  CODE = "FV";
                  END 
  
# 
*     CONVERT THE CARTRIDGE LINK FIELD TO OCTAL AND PRINT IT. 
# 
  
                XWOD(FCT$CLFG(FWD,FPS),DIS);
                RPLINE(OUT$FETP,CODE,COLUMN,2,1); 
                RPLINE(OUT$FETP,DIS$CLFG[0],COLUMN + 2,10,1); 
                RPLINE(OUT$FETP,ER$CODE,COLUMN + 12,1,1); 
                COLUMN = COLUMN + 15; 
                END  # PRINT EIGHT AU ON A LINE # 
  
              LN$CNT = LN$CNT + 1;
              RPLINE(OUT$FETP," ",135,1,0);  # PRINT OUT LINE # 
              END  # PROCESS EACH AU #
  
# 
*     CLOSE THE SFM CATALOG AND RETURN. 
# 
  
            CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
            IF FLAG NQ CMASTAT"NOERR" 
            THEN
              BEGIN 
              SSMSG$PROC[0] = PROCNAME; 
              MESSAGE(SSMSG[0],SYSUDF1);
              RPCLOSE(OUT$FETP);
              RESTPFP(PFP$ABORT); 
              END 
  
            RETURN; 
  
            END  # PROCESS AN *FCT* ENTRY # 
  
          END  # CHECK EACH SELECTED SM # 
  
# 
*     CLOSE THE CATALOG.
# 
  
        CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
        IF FLAG NQ CMASTAT"NOERR" 
        THEN                         # UNABLE TO CLOSE CATALOG #
          BEGIN 
          SSMSG$PROC[0] = PROCNAME; 
          MESSAGE(SSMSG[0],SYSUDF1);
          RPCLOSE(OUT$FETP);
          RESTPFP(PFP$ABORT); 
          END 
  
        ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER # 
  
        END  # PROCESS EACH SUBFAMILY # 
  
# 
*     IF CSN WAS NOT FOUND ISSUE MESSAGE TO DAYFILE AND ABORT.
# 
  
      IF NOT FOUND
      THEN
        BEGIN 
        SSMSG$LINE[0] = " CARTRIDGE NOT FOUND.";
        MESSAGE(SSMSG$BUF[0],SYSUDF1);
        RPCLOSE(OUT$FETP);
        RESTPFP(PFP$ABORT); 
        END 
  
      RETURN; 
  
      END  # USRPTD # 
  
    TERM
