Retro1.org codex

User Tools

Site Tools

Trace: • SSUSE
cdc:nos2.source:opl871:ssuse

Table of Contents

SSUSE

Table Of Contents

  • [00001] PRGM SSUSE
  • [00002] SSUSE - INITIALIZES *SSUSE*.
  • [00007] INITIALIZES *SSUSE*.
  • [00098] PROC ABORT
  • [00099] PROC GETFAM
  • [00100] PROC GETPFP
  • [00101] PROC GETSPS
  • [00102] PROC MESSAGE
  • [00103] PROC RESTPFP
  • [00105] PROC SSINIT
  • [00106] PROC USOPT
  • [00107] PROC USRPBAS
  • [00109] PROC USTAB
  • [00110] PROC XARG
  • [00221] PROC USANALS1)
  • [00222] USANALS - ANALYZES SFMCATALOG ENTRIES FOR A SM.
  • [00227] USANALS - ANALYZES SFM CATALOG ENTRIES FOR A SM.
  • [00262] PROC CGETFCT
  • [00263] PROC CRDAST
  • [00264] PROC LOFPROC
  • [00265] PROC MCLOSE
  • [00266] PROC MESSAGE
  • [00267] PROC MGETENT
  • [00268] PROC MOPEN
  • [00269] PROC RESTPFP
  • [00271] PROC RPCLOSE
  • [00272] PROC SETPFP
  • [00642] PROC USBASLN2)
  • [00643] USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT.
  • [00648] USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT.
  • [00674] PROC BZFILL
  • [00675] PROC RPEJECT
  • [00676] PROC RPLINE
  • [00677] PROC RPSPACE
  • [00678] FUNC XCDD C(10)
  • [00995] PROC USBASTOT
  • [00996] USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE.
  • [01001] USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE.
  • [01022] PROC BZFILL
  • [01023] PROC RPEJECT
  • [01024] PROC RPLINE
  • [01025] PROC RPSPACE
  • [01026] FUNC XCDD C(10)
  • [01222] PROC USHEAD3)
  • [01223] USHEAD - WRITES HEADER ON OUTPUT FILE.
  • [01228] USHEAD - WRITES HEADER LINE ON OUTPUT FILE.
  • [01248] PROC RPLINEX
  • [01271] PROC USOPT
  • [01272] USOPT - CONVERTS PARAMETERS AND CHECKS FOR VALID OPTIONS.
  • [01277] USOPT - CONVERTS AND CHECKS PARAMETERS FOR ALL VALID OPTIONS.
  • [01318] PROC BZFILL
  • [01319] PROC MESSAGE
  • [01320] PROC RESTPFP
  • [01551] PROC USRPBAS
  • [01552] USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS.
  • [01557] USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS.
  • [01602] PROC BZFILL
  • [01603] PROC CCLOSE
  • [01604] PROC COPEN
  • [01605] PROC LOFPROC
  • [01606] PROC MESSAGE
  • [01607] PROC RESTPFP
  • [01609] PROC RPCLOSE
  • [01610] PROC RPEJECT
  • [01611] PROC RPLINE
  • [01612] PROC RPOPEN
  • [01613] PROC RPSPACE
  • [01614] PROC SETPFP
  • [01615] PROC USANALS
  • [01616] PROC USBASLN
  • [01617] PROC USBASTOT
  • [01618] PROC USHEAD
  • [01619] PROC USRPTA
  • [01620] PROC USRPTB
  • [01621] PROC USRPTC
  • [01622] PROC USRPTD
  • [01623] PROC ZFILL
  • [01624] FUNC XCDD C(10)
  • [01888] PROC USRPTA
  • [01889] USRPTA - GENERATES OPTIONAL REPORT A.
  • [01894] USRPTA - GENERATES OPTIONAL REPORT A.
  • [01925] PROC BZFILL
  • [01926] PROC LOFPROC
  • [01927] PROC MCLOSE
  • [01928] PROC MESSAGE
  • [01929] PROC MGETENT
  • [01930] PROC MOPEN
  • [01931] PROC RESTPFP
  • [01933] PROC RPCLOSE
  • [01934] PROC RPEJECT
  • [01935] PROC RPLINE
  • [01936] PROC RPSPACE
  • [01937] PROC SETPFP
  • [01938] FUNC XCDD C(10)
  • [02264] PROC USRPTB
  • [02265] USRPTB - GENERATES OPTIONAL REPORT B.
  • [02270] USRPTB - GENERATES OPTIONAL REPORT B.
  • [02301] PROC BZFILL
  • [02302] PROC CCLOSE
  • [02303] PROC CGETFCT
  • [02304] PROC COPEN
  • [02305] PROC CRDAST
  • [02306] PROC LOFPROC
  • [02307] PROC MESSAGE
  • [02308] PROC RESTPFP
  • [02310] PROC RPCLOSE
  • [02311] PROC RPEJECT
  • [02312] PROC RPLINE
  • [02313] PROC RPSPACE
  • [02314] PROC SETPFP
  • [02315] PROC ZFILL
  • [02316] FUNC XCDD C(10)
  • [02754] PROC USRPTC
  • [02755] USRPTC - GENERATES OPTIONAL REPORT C.
  • [02760] USRPTC - GENERATES OPTIONAL REPORT C.
  • [02785] PROC BZFILL
  • [02786] PROC CCLOSE
  • [02787] PROC CGETFCT
  • [02788] PROC COPEN
  • [02789] PROC LOFPROC
  • [02790] PROC MESSAGE
  • [02791] PROC RESTPFP
  • [02793] PROC RPCLOSE
  • [02794] PROC RPEJECT
  • [02795] PROC RPLINE
  • [02796] PROC RPSPACE
  • [02797] PROC SETPFP
  • [02798] PROC ZFILL
  • [02799] FUNC XCDD C(10)
  • [03144] PROC USRPTD
  • [03145] USRPTD - GENERATES OPTIONAL REPORT D.
  • [03150] USRPTD - GENERATES OPTIONAL REPORT D.
  • [03184] PROC BZFILL
  • [03185] PROC CCLOSE
  • [03186] PROC CGETFCT
  • [03187] PROC COPEN
  • [03188] PROC CRDAST
  • [03189] PROC LOFPROC
  • [03190] PROC MESSAGE
  • [03191] PROC RESTPFP
  • [03193] PROC RPCLOSE
  • [03194] PROC RPEJECT
  • [03195] PROC RPLINE
  • [03196] PROC RPSPACE
  • [03197] PROC SETPFP
  • [03198] PROC ZFILL
  • [03199] FUNC XCDD C(10)
  • [03200] FUNC XCOD C(10)
  • [03201] PROC XWOD

Source Code

SSUSE.txt 
  1. PRGM SSUSE;
  2. # TITLE SSUSE - INITIALIZES *SSUSE*.                                  #
  3.  
  4.       BEGIN  # SSUSE #
  5.  
  6. #
  7. ***   SSUSE - INITIALIZES *SSUSE*.
  8. *
  9. *     THIS PRGM DOES THE INITIALIZATION FOR THE *SSUSE*
  10. *     UTILITY BY PROCESSING THE CONTROL CARD AND SETTING
  11. *     UP POINTERS AND DEFAULT VALUES.
  12. *
  13. *     SSUSE,OP,FM,SM,SB,CN,CM,L.
  14. *
  15. *     PRGM SSUSE.
  16. *
  17. *     ENTRY.     INPUTS TO SSUSE ARE-
  18. *                OP          SELECTS BASIC USAGE REPORT.
  19. *                OP=A        OPTIONAL REPORT A AND THE BASIC REPORT.
  20. *                OP=B        OPTIONAL REPORT B AND THE BASIC REPORT.
  21. *                OP=C        OPTIONAL REPORT C AND THE BASIC REPORT.
  22. *                OP=D        OPTIONAL REPORT D AND THE BASIC REPORT.
  23. *                OP=ABCD     OPTIONAL REPORTS A, B, C, AND D AND ANY
  24. *                            COMBINATION OF A, B, C, AND D MAY
  25. *                            BE USED.
  26. *                OP OMITTED  SAME AS OP.
  27. *
  28. *                FM          USE DEFAULT FAMILY.
  29. *                FM=FAMILY   THE SPECIFIED FAMILY WILL BE REPORTED.
  30. *                FM OMITTED  SAME AS FM.
  31. *
  32. *                SB          ALL SUBFAMILIES ARE TO BE PROCESSED.
  33. *                SB=CHARS    SELECT UP TO EIGHT SUBFAMILIES.  THERE
  34. *                            ARE EIGHT POSSIBLE SUBFAMILIES FROM 0
  35. *                            TO 7 (E.G.  SB=723 SELECTS SUBFAMILIES
  36. *                            2, 3, AND 7).
  37. *                SB OMITTED  SAME AS SB.
  38. *
  39. *                SM          SM A WILL BE REPORTED.
  40. *                SM=CHARS    SELECT UP TO EIGHT SM-S, WHICH CAN
  41. *                            BE ANY OF THE FOLLOWING (E.G.  SM=AGC
  42. *                            SELECTS SM A, C, AND G):
  43. *                            A - SM A
  44. *                            B - SM B
  45. *                            C - SM C
  46. *                            D - SM D
  47. *                            E - SM E
  48. *                            F - SM F
  49. *                            G - SM G
  50. *                            H - SM H
  51. *                SM OMITTED  SAME AS SM.
  52. *
  53. *                L           LISTABLE OUTPUT ON FILE *OUTPUT*.
  54. *                L=LFN       LISTABLE OUTPUT ON FILE *LFN*.
  55. *                L=0         NO OUTPUT FILE GENERATED.
  56. *                L OMITTED   SAME AS L.
  57. *
  58. *                CN          NOT PERMITTED.
  59. *                CN=CSN      THE SELECTED CSN WILL BE REPORTED IN
  60. *                            REPORT D.
  61. *                CN OMITTED  NOT PERMITTED.
  62. *
  63. *                CM          MANUFACTURER OF CARTRIDGE *CN*.  DEFAULT
  64. *                            MANUFACTURER IS USED.
  65. *                CM=A        MANUFACTURER *A-* IS USED, (A- = IBM).
  66. *                CM OMITTED  SAME AS *CM*.
  67. *
  68. *     EXIT.      *SSUSE* PROCESSING COMPLETE OR AN ERROR
  69. *                CONDITION ENCOUNTERED.
  70. *
  71. *     MESSAGES.  1.  SSUSE COMPLETE.
  72. *                2.  SSUSE - ARGUMENT ERROR.
  73. *                3. SSUSE - MUST BE SYSTEM ORIGIN.
  74. *
  75. *     NOTES.     PRGM *SSUSE* INITIALIZES *SSUSE*.  A PARAMETER
  76. *                TABLE IS SET UP BEFORE ANY PROCESSING IS DONE.
  77. *                *SSUSE* THEN PROCESSES THE CONTROL CARD, WHERE THE
  78. *                PROCESSED PARAMETERS ARE RETURNED IN THE COMMON
  79. *                AREA *TUSPCOM*.  ANY SYNTAX ERROR IN THE CONTROL
  80. *                CARD CAUSES *SSUSE* TO ABORT.  AFTER THE PARAMETERS
  81. *                ARE PROCESSED AND SYNTAX CHECKED, THEY ARE THEN
  82. *                CHECKED BY *USOPT* TO SEE IF THE OPTIONS SPECIFIED
  83. *                ARE VALID.  *USOPT* ABORTS WITH A DESCRIPTIVE
  84. *                ERROR MESSAGE WHENEVER IT ENCOUNTERS AN
  85. *                ERROR CONDITION.  PROC *USRPBAS* IS CALLED TO
  86. *                GENERATE THE BASIC AND OPTIONAL REPORTS.  AN
  87. *                *SSUSE COMPLETE* MESSAGE IS ISSUED TO THE DAYFILE
  88. *                IF ALL REPORTS HAVE BEEN GENERATED SUCCESSFULLY.
  89. *     COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
  90. #
  91.  
  92. #
  93. ****  PROC SSUSE - XREF LIST BEGIN.
  94. #
  95.  
  96.       XREF
  97.         BEGIN
  98.         PROC ABORT;                  # CALLS *ABORT* MACRO #
  99.         PROC GETFAM;                 # GETS DEFAULT FAMILY #
  100.         PROC GETPFP;                 # GET USER INDEX AND FAMILY #
  101.         PROC GETSPS;                 # GET SYSTEM ORIGIN STATUS #
  102.         PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
  103.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  104.                                        OR RETURN #
  105.         PROC SSINIT;                 # SETS UP TABLES AND POINTERS #
  106.         PROC USOPT;                  # CHECKS FOR VALID OPTIONS #
  107.         PROC USRPBAS;                # GENERATES BASIC AND OPTIONAL
  108.                                        REPORTS #
  109.         PROC USTAB;                  # SETS UP PARAMETER TABLE #
  110.         PROC XARG;                   # CRACK PARAMETER LIST #
  111.         END
  112.  
  113. #
  114. ****  PROC SSUSE - XREF LIST END.
  115. #
  116.  
  117.       DEF RSLEN      #1#;            # RETURN STATUS WORD LENGTH #
  118.       DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
  119.                                                CONTROL PRESET;
  120. *CALL COMBFAS
  121. *CALL COMBCMD
  122. *CALL COMBMCT
  123. *CALL COMBPFP
  124. *CALL COMXMSC
  125. *CALL COMSPFM
  126. *CALL COMTFMT
  127. *CALL COMTUSE
  128. *CALL COMTUSP
  129.  
  130.       ITEM ARGLIST    U;             # ADDRESS OF ARGUMENT TABLE #
  131.       ITEM DEFAULT    I;             # DEFAULT FAMILY ORDINAL #
  132.       ITEM FAM$NUM    I;             # NUMBER OF FAMILIES #
  133.       ITEM FLAG       I;             # ERROR FLAG #
  134.       ITEM LINK       I;             # LINK FAMILY ORDINAL #
  135.       ITEM SSID       I;             # SUBSYSTEM ID #
  136.  
  137.       ARRAY SPSSTAT [0:0] S(RSLEN);
  138.         BEGIN
  139.         ITEM SPS$STATUS U(00,48,12);  # RETURN STATUS #
  140.         END
  141.  
  142.                                                CONTROL EJECT;
  143.  
  144. #
  145. *     IF THE USER JOB HAS SYSTEM ORIGIN PRIVILEGES THEN SAVE THE USER-S
  146. *     CURRENT FAMILY AND INDEX IN COMMON.
  147. #
  148.  
  149.       GETSPS(SPSSTAT);               # GET SYSTEM ORIGIN STATUS #
  150.       IF SPS$STATUS NQ 0
  151.       THEN
  152.         BEGIN
  153.         SSMSG$LINE[0] = " SSUSE - MUST BE SYSTEM ORIGIN.";
  154.         MESSAGE(SSMSG$BUF[0],SYSUDF1);
  155.         ABORT;
  156.         END
  157.  
  158.       GETPFP(PFP[0]);
  159.       USER$FAM[0] = PFP$FAM[0];
  160.       USER$UI[0] = PFP$UI[0];
  161.  
  162. #
  163. *     PROCESS THE PARAMETERS ON *SSUSE* CALL.
  164. #
  165.  
  166.       USTAB(ARGLIST);                # SET UP THE ARGUMENT LIST #
  167.       XARG(ARGLIST,0,FLAG);          # PROCESS THE CONTROL STATEMENT #
  168.       IF FLAG NQ 0
  169.       THEN                           # SYNTAX ERROR #
  170.         BEGIN
  171.         SSMSG$LINE[0] = " SSUSE - ARGUMENT ERROR.";
  172.         MESSAGE(SSMSG$BUF[0],SYSUDF1);
  173.         RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT #
  174.         END
  175.  
  176. #
  177. *     CONVERT PARAMETERS AND CHECK FOR ALL THE VALID
  178. *     OPTIONS ON THE CONTROL CARD.
  179. #
  180.  
  181.       USOPT;
  182.  
  183. #
  184. *     IF *FM* IS NOT SPECIFIED, USE THE DEFAULT FAMILY.
  185. #
  186.  
  187.       SSID = ATAS;
  188.       GETFAM(FAMT[1],FAM$NUM,LINK,DEFAULT,SSID);
  189.       DEF$FAM = FAM$NAME[DEFAULT];
  190.       IF USARG$FM[0] EQ 0
  191.       THEN
  192.         BEGIN
  193.         USARG$FM[0] = DEF$FAM;
  194.         END
  195.  
  196. #
  197. *     INITIALIZE TABLES AND POINTERS NEEDED BY
  198. *     CATALOG/MAP ACCESS ROUTINES.
  199. #
  200.  
  201.       SSINIT;
  202.  
  203. #
  204. *     GENERATE THE BASIC AND OPTIONAL REPORTS REQUESTED BY
  205. *     THE CONTROL CARD PARAMETERS.
  206. #
  207.  
  208.       USRPBAS;
  209.  
  210. #
  211. *     DISPLAY *SSUSE COMPLETE* IN THE DAYFILE.
  212. #
  213.  
  214.       SSMSG$LINE[0] = " SSUSE COMPLETE.";
  215.       MESSAGE(SSMSG$BUF[0],SYSUDF1);
  216.       RESTPFP(PFP$END);              # RESTORE USER-S *PFP* #
  217.  
  218.       END  # SSUSE #
  219.  
  220.     TERM
  221. PROC USANALS((SUBFAM),(SMID));
  222. # TITLE USANALS - ANALYZES SFMCATALOG ENTRIES FOR A SM.               #
  223.  
  224.       BEGIN  # USANALS #
  225.  
  226. #
  227. **    USANALS - ANALYZES SFM CATALOG ENTRIES FOR A SM.
  228. *
  229. *     THIS PROCEDURE ANALYZES THE *AST* AND *FCT* ENTRIES FOR A SM.
  230. *
  231. *     PROC USANALS((SUBFAM),(SMID)).
  232. *
  233. *     ENTRY     (SUBFAM)   =  SUBFAMILY IDENTIFIER.
  234. *               (SMID)     =  SM IDENTIFIER.
  235. *
  236. *     EXIT      SUB-TOTALS COUNTERS ARE UPDATED IN THE COMMON
  237. *               AREA.
  238. *
  239. *     MESSAGES  1. SFMCATALOG PARITY ERROR.
  240. *               2. FAMILY NOT FOUND.
  241. *               3. SMMAP PARITY ERROR.
  242. *               4. UNABLE TO OPEN SMMAP.
  243. *               5. SSUSE ABNORMAL, USANALS.
  244. *
  245. *     NOTES     PROC *USANALS* CALLS *CRDAST* TO GET THE *AST* FOR THE
  246. *               SPECIFIED SM.  IT THEN CALLS *CGETFCT* TO GET AN *FCT*
  247. *               ENTRY.  THE VARIOUS FIELDS WITHIN EACH *AST* AND *FCT*
  248. *               ENTRY ARE CHECKED FOR CERTAIN CONDITIONS AND THE
  249. *               APPROPRIATE COUNTERS ARE UPDATED.  THE SMMAP IS
  250. *               SEARCHED FOR EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY.
  251. #
  252.  
  253.       ITEM SUBFAM     I;             # SUBFAMILY IDENTIFIER #
  254.       ITEM SMID       U;             # SM IDENTIFIER #
  255.  
  256. #
  257. ****  PROC USANALS - XREF LIST BEGIN.
  258. #
  259.  
  260.       XREF
  261.         BEGIN
  262.         PROC CGETFCT;                # GETS *FCT* ENTRY #
  263.         PROC CRDAST;                 # READS *AST* #
  264.         PROC LOFPROC;                # LIST OF FILES PROCESSOR #
  265.         PROC MCLOSE;                 # CLOSE SMMAP #
  266.         PROC MESSAGE;                # ISSUES MESSAGE IN DAYFILE #
  267.         PROC MGETENT;                # GETS MAP ENTRY #
  268.         PROC MOPEN;                  # OPENS SMMAP #
  269.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  270.                                        OR RETURN #
  271.         PROC RPCLOSE;                # CLOSES THE REPORT FILE #
  272.         PROC SETPFP;                 # SET FAMILY AND USER INDEX #
  273.         END
  274.  
  275. #
  276. ****  PROC USANALS - XREF LIST END.
  277. #
  278.  
  279.       DEF PROCNAME #"USANALS."#;     # PROC NAME #
  280.       DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
  281. *CALL COMBFAS
  282. *CALL COMBCMD
  283. *CALL COMBCMS
  284. *CALL,COMBMAP
  285. *CALL,COMBPFP
  286. *CALL,COMSPFM
  287. *CALL COMBMCT
  288. *CALL COMXMSC
  289. *CALL COMTOUT
  290. *CALL COMTUSE
  291. *CALL COMTUSP
  292.  
  293.       ITEM BADDR      I;             # *AST* BUFFER ADDRESS #
  294.       ITEM BFADDR     I;             # *FCT* BUFFER ADDRESS #
  295.       ITEM FLAG       I;             # ERROR FLAG #
  296.       ITEM GP         I;             # GROUP #
  297.       ITEM I          I;             # LOOP VARIABLE #
  298.       ITEM N          I;             # LOOP VARIABLE #
  299.       ITEM MAP$ORD    I;             # SMMAP ORDINAL #
  300.       ITEM SM$ADDR    I;             # ADDRESS OF SMMAP #
  301.       ITEM Y          I;             # Y COORDINATE #
  302.       ITEM Z          I;             # Z COORDINATE #
  303.  
  304.       ARRAY SMMAP$NM [0:0] P(1);     # ARRAY TO BUILD SMMAP #
  305.         BEGIN
  306.         ITEM SMAP$NAME  C(00,00,07); # SMMAP FILE NAME #
  307.         ITEM SMAP$CHAR  C(00,00,05); # FIRST FIVE CHARACTERS #
  308.         ITEM SMAP$SMID  C(00,30,01); # SM-ID #
  309.         ITEM SMAP$Z     U(00,36,24) = [0];  # ZERO FILL FILE NAME #
  310.         END
  311.  
  312.                                                CONTROL EJECT;
  313.  
  314. #
  315. *     GET THE *AST* AND CHECK THE RETURNED ERROR STATUS.
  316. #
  317.  
  318.       BADDR = LOC(US$ASTENT[0]);
  319.       CRDAST(USARG$FM[0],SUBFAM,SMID,BADDR,0,FLAG);
  320.       IF FLAG NQ CMASTAT"NOERR"
  321.       THEN                           # UNABLE TO GET *AST* #
  322.         BEGIN
  323.         SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  324.         MESSAGE(SSMSG$BUF[0],SYSUDF1);
  325.         RPCLOSE(OUT$FETP);
  326.         RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT #
  327.         END
  328.  
  329.       P<AST> = BADDR;
  330.  
  331. #
  332. *     PROCESS ALL *AST* AND *FCT* ENTRIES.
  333. #
  334.  
  335.       SLOWFOR I = 16 STEP 1 UNTIL PRM$ENTRC[SMID] + 15
  336.       DO
  337.         BEGIN  # PROCESS AN *AST* AND *FCT* ENTRY #
  338.  
  339. #
  340. *     GET AN *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
  341. #
  342.  
  343.         BFADDR = LOC(US$FCTENT[0]);
  344.         CGETFCT(USARG$FM[0],SUBFAM,SMID,I,BFADDR,0,FLAG);
  345.         IF FLAG NQ CMASTAT"NOERR"
  346.         THEN                         # UNABLE TO GET *FCT* #
  347.           BEGIN
  348.           SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  349.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  350.           RPCLOSE(OUT$FETP);
  351.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  352.           END
  353.  
  354.         P<FCT> = BFADDR;
  355.         GP = I / MAXGRT;             # SET GROUP INDEX #
  356.  
  357. #
  358. *     UPDATE CUBE COUNTER AND CHECK CUBE STATUS.  IF NO CARTRIDGE
  359. *     ASSIGNED TO THIS CUBICLE, GET NEXT ENTRY.
  360. #
  361.  
  362.         IF FCT$CSND[0] EQ "  "
  363.           OR FCT$CSNI[0] EQ 0
  364.         THEN                         # NO CARTRIDGE ASSIGNED TO CUBE #
  365.           BEGIN
  366.           TEST I;
  367.           END
  368.  
  369.         GRP$LOC[GP] = GRP$LOC[GP] + 1;
  370.         GRP$RES[GP] = GRP$RES[GP] + 1;  # NUM CARTRIDGES IN GROUP #
  371.  
  372. #
  373. *     UPDATE THE AVAILABLE AU FOR SMALL AND LARGE FILES.
  374. #
  375.  
  376.         GRP$AUSF[GP] = GRP$AUSF[GP] + AST$AUSF[I];
  377.         GRP$AULF[GP] = GRP$AULF[GP] + AST$AULF[I];
  378.  
  379. #
  380. *     CHECK FOR AVAILABLE OFF CARTRIDGE LINKS AND UPDATE THE COUNTER.
  381. #
  382.  
  383.         IF NOT AST$NOCLF[I]
  384.         THEN                         # OFF CARTRIDGE LINKS AVAILABLE #
  385.           BEGIN
  386.           GRP$OCL[GP] = GRP$OCL[GP] + 1;
  387.           END
  388.  
  389. #
  390. *     CHECK *FCT* FLAGS AND UPDATE THE APPROPRIATE COUNTERS.
  391. #
  392.  
  393.         IF FCT$IAF[0]
  394.         THEN                         # INHIBIT ALLOCATION #
  395.           BEGIN
  396.           GRP$INH[GP] = GRP$INH[GP] + 1;
  397.           END
  398.  
  399.         IF FCT$LCF[0]
  400.         THEN                         # CARTRIDGE LOST #
  401.           BEGIN
  402.           GRP$LOST[GP] = GRP$LOST[GP] + 1;
  403.           END
  404.  
  405.         IF FCT$EEF[0]
  406.         THEN                         # EXCESSIVE ERRORS #
  407.           BEGIN
  408.           GRP$XPE[GP] = GRP$XPE[GP] + 1;
  409.           END
  410.  
  411.         IF FCT$SEF[0]
  412.         THEN                         # SMMAP ERROR #
  413.           BEGIN
  414.           GRP$SE[GP] = GRP$SE[GP] + 1;
  415.           END
  416.  
  417.         IF FCT$FCF[0]
  418.         THEN                         # FREE CARTRIDGE #
  419.           BEGIN
  420.           GRP$FRC[GP] = GRP$FRC[GP] + 1;
  421.           END
  422.  
  423. #
  424. *     CHECK EACH AU FOR ERRORS AND AVAILABILITY.  UPDATE THE
  425. *     APPROPRIATE COUNTERS.
  426. #
  427.  
  428.         SLOWFOR N = 1 STEP 1 UNTIL INAVOT
  429.         DO
  430.           BEGIN  # FOR EACH AU #
  431.  
  432. #
  433. *     CHECK AU FLAGS, UPDATE COUNTERS IF NECESSARY.
  434. #
  435.  
  436.           SETFCTX(N);                # SET *FWD* AND *FPS* VALUES #
  437.           IF FCT$AUCF(FWD,FPS) NQ 0
  438.           THEN                       # AU CONFLICT #
  439.             BEGIN
  440.             GRP$AUC[GP] = GRP$AUC[GP] + 1;
  441.             END
  442.  
  443.           IF FCT$FRCF(FWD,FPS) NQ 0
  444.           THEN                       # FROZEN CHAIN #
  445.             BEGIN
  446.             GRP$FC[GP] = GRP$FC[GP] + 1;
  447.             END
  448.  
  449.           IF FCT$SFF(FWD,FPS) NQ 0
  450.           THEN                       # START OF FRAGMENT #
  451.             BEGIN
  452.             GRP$SF[GP] = GRP$SF[GP] + 1;
  453.             END
  454.  
  455.           IF FCT$FAUF(FWD,FPS) NQ 0
  456.           THEN                       # FLAWED AU #
  457.             BEGIN
  458.             IF FCT$FBF(FWD,FPS) NQ 0
  459.             THEN                     # FLAWED AND ALLOCATED #
  460.               BEGIN
  461.               GRP$FB[GP] = GRP$FB[GP] + 1;
  462.               END
  463.  
  464.             ELSE                     # FLAWED AND UNALLOCATED #
  465.               BEGIN
  466.               GRP$FA[GP] = GRP$FA[GP] +1;
  467.               END
  468.  
  469.             END
  470.  
  471.           END  # FOR EACH AU #
  472.  
  473.         END  # PROCESS AN *AST* AND AN *FCT* ENTRY #
  474.  
  475. #
  476. *     SEARCH THE SMMAP FOR ANY EMPTY CUBICLES ASSIGNED
  477. *     TO THIS SUBFAMILY.
  478. #
  479.  
  480.       PFP$WRD0[0] = 0;
  481.       PFP$FAM[0] = DEF$FAM;
  482.       PFP$UI[0] = DEF$UI;
  483.       PFP$FG1[0] = TRUE;
  484.       PFP$FG4[0] = TRUE;
  485.       SETPFP(PFP[0]);
  486.       IF PFP$STAT NQ 0
  487.       THEN                           # FAMILY NOT FOUND #
  488.         BEGIN
  489.         SSMSG$LINE[0] = " FAMILY NOT FOUND.";
  490.         MESSAGE(SSMSG$BUF[0],SYSUDF1);
  491.         RPCLOSE(OUT$FETP);
  492.         RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT #
  493.         END
  494.  
  495.  
  496.       SMAP$SMID[0] = SMID;
  497.       SMAP$CHAR[0] = SMMAP;
  498.  
  499. #
  500. *     OPEN THE SMMAP AND CHECK THE RETURNED ERROR STATUS.
  501. #
  502.  
  503.       MOPEN(SMID,SMAP$NAME[0],"RM",FLAG);
  504.       IF FLAG EQ CMASTAT"NOERR"
  505.       THEN
  506.         BEGIN
  507.         LOFPROC(SMAP$NAME[0]);       # ADD LFN TO LIST OF FILES #
  508.         END
  509.  
  510.       SM$ADDR = LOC(MAPBUFR[0]);
  511.       P<SMUMAP> = SM$ADDR;
  512.  
  513.       IF FLAG NQ CMASTAT"NOERR"
  514.       THEN
  515.         BEGIN  # SMMAP NOT OPENED SUCCESSFULLY #
  516.         IF FLAG EQ CMASTAT"CIOERR"
  517.         THEN
  518.           BEGIN
  519.           SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
  520.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  521.           RPCLOSE(OUT$FETP);
  522.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  523.           END
  524.  
  525.         IF FLAG EQ CMASTAT"INTLK"  ##
  526.           OR FLAG EQ CMASTAT"ATTERR"
  527.         THEN
  528.           BEGIN
  529.           SSMSG$LINE[0] = " UNABLE TO OPEN SMMAP.";
  530.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  531.           RPCLOSE(OUT$FETP);
  532.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  533.           END
  534.  
  535.         ELSE
  536.           BEGIN
  537.           SSMSG$PROC[0] = PROCNAME;
  538.           MESSAGE(SSMSG[0],SYSUDF1);
  539.           RPCLOSE(OUT$FETP);
  540.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  541.           END
  542.  
  543.         END  # SMMAP NOT OPENED SUCCESSFULLY #
  544.  
  545. #
  546. *     PROCESS EACH Y,Z PAIR.
  547. #
  548.  
  549.       SLOWFOR Y = 0 STEP 1 UNTIL MAX$Y
  550.       DO
  551.         BEGIN  # PROCESS EACH Y COORDINATE #
  552.  
  553.         SLOWFOR Z = 0 STEP 1 UNTIL MAX$Z
  554.         DO
  555.           BEGIN  # PROCESS EACH Z COORDINATE #
  556.  
  557. #
  558. *     DO NOT PROCESS THE COORDINATES CONTAINING THE DRD-S
  559. *     OR THE ENTRY-EXIT TRAY.
  560. #
  561.  
  562.           IF (Z LQ 1               ##
  563.             AND (Y LQ 15 AND Y GQ 11))  ##
  564.               OR Z EQ Z$NO$CUBE
  565.           THEN
  566.             BEGIN
  567.             TEST Z;
  568.             END
  569.  
  570. #
  571. *     CALCULATE THE ORDINAL OF THE SMMAP ENTRY.
  572. #
  573.  
  574.           MAP$ORD = MAXORD - Z - (Y * 16);
  575.  
  576. #
  577. *     GET THE SMMAP ENTRY AND CHECK THE RETURNED ERROR STATUS.
  578. #
  579.  
  580.           MGETENT(SMID,MAP$ORD,SM$ADDR,FLAG);
  581.           IF FLAG NQ CMASTAT"NOERR"
  582.           THEN
  583.             BEGIN  # CHECK FOR TYPE OF ERROR #
  584.             IF FLAG EQ CMASTAT"CIOERR"
  585.             THEN
  586.               BEGIN
  587.               SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
  588.               MESSAGE(SSMSG$BUF[0],SYSUDF1);
  589.               RPCLOSE(OUT$FETP);
  590.               RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT #
  591.               END
  592.  
  593.             ELSE
  594.               BEGIN
  595.               SSMSG$PROC[0] = PROCNAME;
  596.               MESSAGE(SSMSG[0],SYSUDF1);
  597.               RPCLOSE(OUT$FETP);
  598.               RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT #
  599.               END
  600.  
  601.             END  # CHECK FOR TYPE OF ERROR #
  602.  
  603. #
  604. *     SEARCH FOR EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY.
  605. #
  606.  
  607.           IF CM$CODE[0] NQ CUBSTAT"SUBFAM"
  608.           THEN                       # NOT IN ANY SUBFAMILY #
  609.             BEGIN
  610.             TEST Z;
  611.             END
  612.  
  613.           IF CM$FMLYNM[0] EQ USARG$FM[0]    ##
  614.             AND CM$SUB[0] EQ SUBFAM         ##
  615.             AND CM$FCTORD[0] EQ 0
  616.           THEN                       # FOUND EMPTY CUBICLE #
  617.             BEGIN
  618.             GRP$LOC[0] = GRP$LOC[0] + 1;
  619.             END
  620.  
  621.           END  # PROCESS EACH Z COORDINATE #
  622.  
  623.         END  # PROCESS EACH Y COORDINATE #
  624.  
  625. #
  626. *     CLOSE THE SMMAP.
  627. #
  628.  
  629.       MCLOSE(SMID,FLAG);
  630.       IF FLAG NQ CMASTAT"NOERR"
  631.       THEN
  632.         BEGIN
  633.         SSMSG$PROC[0] = PROCNAME;
  634.         MESSAGE(SSMSG[0],SYSUDF1);
  635.         RPCLOSE(OUT$FETP);
  636.         RESTPFP(PFP$ABORT);
  637.         END
  638.  
  639.       END  # USANALS #
  640.  
  641.     TERM
  642. PROC USBASLN((SUBFAM),(SM));
  643. # TITLE USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT.           #
  644.  
  645.       BEGIN  # USBASLN #
  646.  
  647. #
  648. **    USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT.
  649. *
  650. *     THIS PROCEDURE PRINTS OUT THE BASIC USAGE REPORT INFORMATION
  651. *     TO THE REPORT FILE.
  652. *
  653. *     PROC USBASLN((SUBFAM),(SM)).
  654. *
  655. *     ENTRY.    (SUBFAM) = SUBFAMILY IDENTIFIER.
  656. *               (SM)     = SM IDENTIFIER.
  657. *
  658. *     EXIT      BASIC REPORT LINES HAVE BEEN WRITTEN TO
  659. *               THE REPORT FILE.
  660. *
  661. *     NOTES     PROC *USBASLN* CALLS *XCDD* TO CONVERT THE
  662. *               GROUP TOTALS IN THE *GRP$TOT* ARRAY FROM INTEGER
  663. *               TO DISPLAY CODE.  THESE VALUES ARE THEN DISPLAYED
  664. *               IN THE REPORT FILE.  TOTALS ARE ACCUMULATED FOR
  665. *               THE SM AND SUBFAMILY.
  666. #
  667.  
  668. #
  669. ****  PROC USBASLN - XREF LIST BEGIN.
  670. #
  671.  
  672.       XREF
  673.         BEGIN
  674.         PROC BZFILL;                 # BLANK FILL CHARACTERS #
  675.         PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
  676.         PROC RPLINE;                 # WRITES A LINE TO REPORT FILE #
  677.         PROC RPSPACE;                # PUT BLANK LINE ON REPORT FILE #
  678.         FUNC XCDD  C(10);            # CONVERTS INTEGERS TO DISPLAY #
  679.         END
  680.  
  681. #
  682. ****  PROC USBASLN - XREF LIST END.
  683. #
  684.  
  685.       DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
  686. *CALL COMBFAS
  687. *CALL COMBBZF
  688. *CALL COMBMCT
  689. *CALL COMXMSC
  690. *CALL COMTOUT
  691. *CALL COMTUSE
  692. *CALL COMTUSP
  693.  
  694.       ITEM GP         I;             # LOOP VARIABLE #
  695.       ITEM LN$CNT     I;             # LINE COUNT #
  696.       ITEM SM         I;             # SM IDENTIFIER #
  697.       ITEM SUBFAM     I;             # SUBFAMILY IDENTIFIER #
  698.       ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
  699.       ITEM TEMP$SM    C(1);          # SM CHARACTER #
  700.       ITEM TOT        I;             # ARRAY INDEX FOR TOTALS #
  701.                                                CONTROL EJECT;
  702.  
  703.       TEMP$FAM = USARG$FM[0];
  704.       BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  705.       TEMP$SM = SM;
  706.  
  707. #
  708. *     WRITE HEADER TO REPORT FILE IF NEW PAGE.
  709. #
  710.  
  711.       IF (LN$CNT / MAX$LN) * MAX$LN EQ LN$CNT
  712.       THEN                           # PAGE EJECT AND PRINT HEADER #
  713.         BEGIN
  714.         RPEJECT(OUT$FETP);
  715.         RPLINE(OUT$FETP,"SSUSE BASIC REPORT",5,18,1);
  716.         RPLINE(OUT$FETP,"FAMILY = ",35,9,1);
  717.         RPLINE(OUT$FETP,TEMP$FAM,44,7,0);
  718.  
  719. #
  720. *     WRITE NOTES TO REPORT FILE.
  721. #
  722.  
  723.         RPSPACE(OUT$FETP,SP"SPACE",1);
  724.         RPLINE(OUT$FETP,"CUBE = CUBICLES",5,15,1);
  725.         RPLINE(OUT$FETP,"CARTRIDGE FLAGS",36,15,1);
  726.         RPLINE(OUT$FETP,"AU FLAGS",86,8,0);
  727.         RPLINE(OUT$FETP,"CART = CARTRIDGES",5,17,1);
  728.         RPLINE(OUT$FETP,"M = MISSING",37,11,1);
  729.         RPLINE(OUT$FETP,"FA = FLAWED AND ALLOCATED",87,25,0);
  730.         RPLINE(OUT$FETP,"I = INHIBIT ALLOCATION",37,22,1);
  731.         RPLINE(OUT$FETP,"FU = FLAWED AND UNALLOCATED",87,27,0);
  732.         RPLINE(OUT$FETP,"** = SUBFAMILY TOTAL",5,20,1);
  733.         RPLINE(OUT$FETP,"F = FREE CARTRIDGE",37,18,1);
  734.         RPLINE(OUT$FETP,"SF = START OF FRAGMENT",87,22,0);
  735.         RPLINE(OUT$FETP,"-  = UNASSIGNED GROUP",5,21,1);
  736.         RPLINE(OUT$FETP,"L = OFF CARTRIDGE LINKS AVAILABLE",37,33,1);
  737.         RPLINE(OUT$FETP,"FC = FROZEN CHAIN",87,17,0);
  738.         RPLINE(OUT$FETP,"P = EXCESSIVE PARITY ERRORS",37,27,1);
  739.         RPLINE(OUT$FETP,"AC = AU CONFLICT",87,16,0);
  740.         RPLINE(OUT$FETP,"E = MAP ERROR(AS DETECTED BY SSVAL)",37,36,0);
  741.         RPSPACE(OUT$FETP,SP"SPACE",1);
  742.  
  743. #
  744. *     WRITE COLUMN HEADINGS TO REPORT FILE.
  745. #
  746.  
  747.         RPLINE(OUT$FETP,"----AVAILABLE----",24,17,1);
  748.         RPLINE(OUT$FETP,"-----NUMBER CARTRIDGES FLAGGED----",43,34,1);
  749.         RPLINE(OUT$FETP,"-------------NUMBER AU FLAGGED",81,30,1);
  750.         RPLINE(OUT$FETP,"-------------",111,13,0);
  751.         RPLINE(OUT$FETP,"SUB SM GR",1,9,1);
  752.         RPLINE(OUT$FETP,"CUBE  CART",12,10,1);
  753.         RPLINE(OUT$FETP,"AU        AU",26,12,1);
  754.         RPLINE(OUT$FETP,"M     I     F     L     P     E",46,31,1);
  755.         RPLINE(OUT$FETP,"FA       FU",86,11,1);
  756.         RPLINE(OUT$FETP,"SF       FC       AC",104,20,0);
  757.         RPLINE(OUT$FETP,"(SMALL)   (LARGE)",24,17,0);
  758.         RPSPACE(OUT$FETP,SP"SPACE",1);
  759.         LN$CNT = 16;
  760.         END
  761.  
  762. #
  763. *     SET INDEX TO ACCUMULATE TOTALS.
  764. #
  765.  
  766.       TOT = MAXGP + 1;
  767.  
  768. #
  769. *     CONVERT THE TOTALS FOR EACH GROUP TO DISPLAY CODE AND WRITE
  770. *     THEM TO THE REPORT FILE.  THE FIRST TIME THROUGH (GP = 0)
  771. *     THE NUMBER OF EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY WILL
  772. *     BE PRINTED.  THE LAST TIME THROUGH (GP = MAXGP + 1) THE SM
  773. *     TOTALS WILL BE PRINTED.
  774. #
  775.  
  776.       SLOWFOR GP = 0 STEP 1 UNTIL MAXGP + 1
  777.       DO
  778.         BEGIN  # FOR EACH GROUP #
  779.  
  780. #
  781. *     WRITE GROUP SUBTOTALS TO REPORT FILE.  IF NO CUBICLES ARE
  782. *     ASSIGNED TO THIS GROUP, PROCESS THE NEXT GROUP.
  783. #
  784.  
  785.         IF GP EQ MAXGP + 1
  786.         THEN                         # PRINT TOTAL FOR ALL GROUPS #
  787.           BEGIN
  788.           CHAR$10[0] = XCDD(SUBFAM);
  789.           RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
  790.           RPLINE(OUT$FETP,TEMP$SM,5,1,1);
  791.           RPLINE(OUT$FETP,"**",8,2,1);
  792.           END
  793.  
  794.         ELSE                         # PRINT ONE GROUP AT A TIME #
  795.           BEGIN
  796.           IF GRP$LOC[GP] EQ 0
  797.           THEN                       # NO CUBICLES IN THIS GROUP #
  798.             BEGIN
  799.             TEST GP;
  800.             END
  801.  
  802.           CHAR$10[0] = XCDD(SUBFAM);
  803.           RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
  804.           RPLINE(OUT$FETP,TEMP$SM,5,1,1);
  805.           IF GP EQ 0
  806.           THEN
  807.             BEGIN
  808.             RPLINE(OUT$FETP,"-",9,1,1);
  809.             END
  810.  
  811.           ELSE
  812.             BEGIN
  813.             CHAR$10[0] = XCDD(GP);
  814.             RPLINE(OUT$FETP,CHAR$R2[0],8,2,1);
  815.             END
  816.  
  817.           END
  818.  
  819. #
  820. *     LIST THE NUMBER OF CUBICLES ASSIGNED TO A GROUP.
  821. #
  822.  
  823.         CHAR$10[0] = XCDD(GRP$LOC[GP]);
  824.         RPLINE(OUT$FETP,CHAR$R4[0],12,4,1);
  825.  
  826. #
  827. *     LIST THE NUMBER OF CARTRIDGES IN A GROUP.
  828. #
  829.  
  830.         CHAR$10[0] = XCDD(GRP$RES[GP]);
  831.         RPLINE(OUT$FETP,CHAR$R4[0],18,4,1);
  832.  
  833. #
  834. *     LIST THE NUMBER OF AVAILABLE AU FOR SMALL AND LARGE FILES.
  835. #
  836.  
  837.         CHAR$10[0] = XCDD(GRP$AUSF[GP]);
  838.         RPLINE(OUT$FETP,CHAR$R7[0],24,7,1);
  839.         CHAR$10[0] = XCDD(GRP$AULF[GP]);
  840.         RPLINE(OUT$FETP,CHAR$R7[0],34,7,1);
  841.  
  842. #
  843. *     LIST THE NUMBER OF LOST CARTRIDGES.
  844. #
  845.  
  846.         CHAR$10[0] = XCDD(GRP$LOST[GP]);
  847.         RPLINE(OUT$FETP,CHAR$R4[0],43,4,1);
  848.  
  849. #
  850. *     LIST THE NUMBER OF CARTRIDGES WITH THE INHIBIT FLAG SET.
  851. #
  852.  
  853.         CHAR$10[0] = XCDD(GRP$INH[GP]);
  854.         RPLINE(OUT$FETP,CHAR$R4[0],49,4,1);
  855.  
  856. #
  857. *     LIST THE NUMBER OF CARTRIDGES WITH FREE CARTRIDGE FLAG SET.
  858. #
  859.  
  860.         CHAR$10[0] = XCDD(GRP$FRC[GP]);
  861.         RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
  862.  
  863. #
  864. *     LIST THE NUMBER OF CARTRIDGES WITH AVAILABLE OFF-CARTRIDGE LINKS.
  865. #
  866.  
  867.         CHAR$10[0] = XCDD(GRP$OCL[GP]);
  868.         RPLINE(OUT$FETP,CHAR$R4[0],61,4,1);
  869.  
  870. #
  871. *     LIST THE NUMBER OF CARTRIDGES WITH EXCESSIVE PARITY ERRORS.
  872. #
  873.  
  874.         CHAR$10[0] = XCDD(GRP$XPE[GP]);
  875.         RPLINE(OUT$FETP,CHAR$R4[0],67,4,1);
  876.         CHAR$10[0] = XCDD(GRP$SE[GP]);
  877.         RPLINE(OUT$FETP,CHAR$R4[0],73,4,1);
  878.  
  879. #
  880. *     LIST THE NUMBER OF FLAWED AND ALLOCATED AU.
  881. #
  882.  
  883.         CHAR$10[0] = XCDD(GRP$FB[GP]);
  884.         RPLINE(OUT$FETP,CHAR$R7[0],81,7,1);
  885.  
  886. #
  887. *     LIST THE NUMBER OF FLAWED AND UNALLOCATED AU.
  888. #
  889.  
  890.         CHAR$10[0] = XCDD(GRP$FA[GP]);
  891.         RPLINE(OUT$FETP,CHAR$R7[0],90,7,1);
  892.  
  893. #
  894. *     LIST THE NUMBER OF START OF FRAGMENT AU.
  895. #
  896.  
  897.         CHAR$10[0] = XCDD(GRP$SF[GP]);
  898.         RPLINE(OUT$FETP,CHAR$R7[0],99,7,1);
  899.  
  900. #
  901. *     LIST THE NUMBER OF FROZEN CHAIN AU.
  902. #
  903.  
  904.         CHAR$10[0] = XCDD(GRP$FC[GP]);
  905.         RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
  906.  
  907. #
  908. *     LIST THE NUMBER OF AU WITH ALLOCATION CONFLICT.
  909. #
  910.  
  911.         CHAR$10[0] = XCDD(GRP$AUC[GP]);
  912.         RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
  913.         LN$CNT = LN$CNT + 1;
  914.  
  915. #
  916. *     DO NOT ACCUMULATE TOTALS THE LAST TIME THROUGH.
  917. #
  918.  
  919.         IF GP EQ MAXGP + 1
  920.         THEN                         # DO NOT ADD TO TOTALS #
  921.           BEGIN
  922.           RPSPACE(OUT$FETP,SP"SPACE",1);
  923.           LN$CNT = LN$CNT + 1;
  924.           TEST GP;
  925.           END
  926.  
  927. #
  928. *     TOTALS FOR ALL GROUPS IN A SM PER SUBFAMILY ARE ACCUMULATED
  929. *     UNDER THE MAXGP+1 INDEX OF THE GROUP TOTALS ARRAY.
  930. *     *GRP$TOT[MAXGP+1]*.
  931. #
  932.  
  933.         GRP$AUC[TOT] = GRP$AUC[TOT] + GRP$AUC[GP];
  934.         GRP$AULF[TOT] = GRP$AULF[TOT] + GRP$AULF[GP];
  935.         GRP$AUSF[TOT] = GRP$AUSF[TOT] + GRP$AUSF[GP];
  936.         GRP$FA[TOT] = GRP$FA[TOT] + GRP$FA[GP];
  937.         GRP$FB[TOT] = GRP$FB[TOT] + GRP$FB[GP];
  938.         GRP$FC[TOT] = GRP$FC[TOT] + GRP$FC[GP];
  939.         GRP$FRC[TOT] = GRP$FRC[TOT] + GRP$FRC[GP];
  940.         GRP$INH[TOT] = GRP$INH[TOT] + GRP$INH[GP];
  941.         GRP$LOC[TOT] = GRP$LOC[TOT] + GRP$LOC[GP];
  942.         GRP$LOST[TOT] = GRP$LOST[TOT] + GRP$LOST[GP];
  943.         GRP$OCL[TOT] = GRP$OCL[TOT] + GRP$OCL[GP];
  944.         GRP$RES[TOT] = GRP$RES[TOT] + GRP$RES[GP];
  945.         GRP$SE[TOT] = GRP$SE[TOT] + GRP$SE[GP];
  946.         GRP$SF[TOT] = GRP$SF[TOT] + GRP$SF[GP];
  947.         GRP$XPE[TOT] = GRP$XPE[TOT] + GRP$XPE[GP];
  948.         END  # FOR EACH GROUP #
  949.  
  950. #
  951. *     ACCUMULATE SM TOTALS.
  952. #
  953.  
  954.       SM$AUC[SM] = SM$AUC[SM] + GRP$AUC[TOT];
  955.       SM$AULF[SM] = SM$AULF[SM] + GRP$AULF[TOT];
  956.       SM$AUSF[SM] = SM$AUSF[SM] + GRP$AUSF[TOT];
  957.       SM$FA[SM] = SM$FA[SM] + GRP$FA[TOT];
  958.       SM$FB[SM] = SM$FB[SM] + GRP$FB[TOT];
  959.       SM$FC[SM] = SM$FC[SM] + GRP$FC[TOT];
  960.       SM$FRC[SM] = SM$FRC[SM] + GRP$FRC[TOT];
  961.       SM$INH[SM] = SM$INH[SM] + GRP$INH[TOT];
  962.       SM$LOC[SM] = SM$LOC[SM] + GRP$LOC[TOT];
  963.       SM$LOST[SM] = SM$LOST[SM] + GRP$LOST[TOT];
  964.       SM$OCL[SM] = SM$OCL[SM] + GRP$OCL[TOT];
  965.       SM$RES[SM] = SM$RES[SM] + GRP$RES[TOT];
  966.       SM$SE[SM] = SM$SE[SM] + GRP$SE[TOT];
  967.       SM$SF[SM] = SM$SF[SM] + GRP$SF[TOT];
  968.       SM$XPE[SM] = SM$XPE[SM] + GRP$XPE[TOT];
  969.  
  970. #
  971. *     ACCUMULATE SUBFAMILY TOTALS.
  972. #
  973.  
  974.       SF$AUC[SUBFAM] = SF$AUC[SUBFAM] + GRP$AUC[TOT];
  975.       SF$AULF[SUBFAM] = SF$AULF[SUBFAM] + GRP$AULF[TOT];
  976.       SF$AUSF[SUBFAM] = SF$AUSF[SUBFAM] + GRP$AUSF[TOT];
  977.       SF$FA[SUBFAM] = SF$FA[SUBFAM] + GRP$FA[TOT];
  978.       SF$FB[SUBFAM] = SF$FB[SUBFAM] + GRP$FB[TOT];
  979.       SF$FC[SUBFAM] = SF$FC[SUBFAM] + GRP$FC[TOT];
  980.       SF$FRC[SUBFAM] = SF$FRC[SUBFAM] + GRP$FRC[TOT];
  981.       SF$INH[SUBFAM] = SF$INH[SUBFAM] + GRP$INH[TOT];
  982.       SF$LOC[SUBFAM] = SF$LOC[SUBFAM] + GRP$LOC[TOT];
  983.       SF$LOST[SUBFAM] = SF$LOST[SUBFAM] + GRP$LOST[TOT];
  984.       SF$OCL[SUBFAM] = SF$OCL[SUBFAM] + GRP$OCL[TOT];
  985.       SF$RES[SUBFAM] = SF$RES[SUBFAM] + GRP$RES[TOT];
  986.       SF$SE[SUBFAM] = SF$SE[SUBFAM] + GRP$SE[TOT];
  987.       SF$SF[SUBFAM] = SF$SF[SUBFAM] + GRP$SF[TOT];
  988.       SF$XPE[SUBFAM] = SF$XPE[SUBFAM] + GRP$XPE[TOT];
  989.  
  990.       RETURN;
  991.  
  992.       END  # USBASLN #
  993.  
  994.     TERM
  995. PROC USBASTOT;
  996. # TITLE USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE. #
  997.  
  998.       BEGIN  # USBASTOT #
  999.  
  1000. #
  1001. **    USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE.
  1002. *
  1003. *     PROC USBASTOT.
  1004. *
  1005. *     ENTRY.    (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
  1006. *               (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
  1007. *
  1008. *     EXIT.     TOTALS HAVE BEEN WRITTEN TO REPORT FILE.
  1009. *
  1010. *     NOTES.    PROC *USBASTOT* CALLS *XCDD* TO CONVERT THE VARIOUS
  1011. *               FIELDS IN THE *SM$TOT* AND *SF$TOT* ARRAYS FROM
  1012. *               INTEGER TO DISPLAY CODE.  THE CONVERTED VALUES ARE
  1013. *               WRITTEN TO THE REPORT FILE.
  1014. #
  1015.  
  1016. #
  1017. ****  PROC USBASTOT - XREF LIST BEGIN.
  1018. #
  1019.  
  1020.       XREF
  1021.         BEGIN
  1022.         PROC BZFILL;                 # BLANK FILL CHARACTERS #
  1023.         PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
  1024.         PROC RPLINE;                 # WRITES A LINE TO REPORT FILE #
  1025.         PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE #
  1026.         FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
  1027.         END
  1028.  
  1029. #
  1030. ****  PROC USBASTOT - XREF LIST END.
  1031. #
  1032.  
  1033.       DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
  1034. *CALL COMBFAS
  1035. *CALL COMBBZF
  1036. *CALL COMBMCT
  1037. *CALL COMXMSC
  1038. *CALL COMTOUT
  1039. *CALL COMTUSE
  1040. *CALL COMTUSP
  1041.  
  1042.       ITEM SM         I;             # SM IDENTIFIER #
  1043.       ITEM SUBFAM     I;             # SUBFAMILY IDENTIFIER #
  1044.       ITEM TEMP$FAM   C(7);          # FAMILY CHARACTER #
  1045.       ITEM TEMP$SM    C(1);          # SM CHARACTER #
  1046.                                                CONTROL EJECT;
  1047.  
  1048.       TEMP$FAM = USARG$FM[0];
  1049.       BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  1050.  
  1051. #
  1052. *     WRITE COLUMN HEADINGS TO REPORT FILE.
  1053. #
  1054.  
  1055.       RPEJECT(OUT$FETP);
  1056.       RPLINE(OUT$FETP,"SSUSE BASIC REPORT",5,18,1);
  1057.       RPLINE(OUT$FETP,"SM AND SUBFAMILY TOTALS",27,23,1);
  1058.       RPLINE(OUT$FETP,"FAMILY = ",54,9,1);
  1059.       RPLINE(OUT$FETP,TEMP$FAM,63,7,0);
  1060.       RPSPACE(OUT$FETP,SP"SPACE",1);
  1061.       RPLINE(OUT$FETP,"----AVAILABLE----",24,17,1);
  1062.       RPLINE(OUT$FETP,"-----NUMBER CARTRIDGES FLAGGED----",43,34,1);
  1063.       RPLINE(OUT$FETP,"-------------NUMBER AU FLAGGED",81,30,1);
  1064.       RPLINE(OUT$FETP,"-------------",111,13,0);
  1065.       RPLINE(OUT$FETP,"SUB SM GR",1,9,1);
  1066.       RPLINE(OUT$FETP,"CUBE  CART",12,10,1);
  1067.       RPLINE(OUT$FETP,"AU        AU",26,12,1);
  1068.       RPLINE(OUT$FETP,"M     I     F     L     P     E",46,31,1);
  1069.       RPLINE(OUT$FETP,"FA       FU",86,11,1);
  1070.       RPLINE(OUT$FETP,"SF       FC       AC",104,20,0);
  1071.       RPLINE(OUT$FETP,"(SMALL)   (LARGE)",24,17,0);
  1072.       RPSPACE(OUT$FETP,SP"SPACE",1);
  1073.       RPLINE(OUT$FETP,"SM TOTALS FOR SPECIFIED SUBFAMILIES",1,35,0);
  1074.  
  1075. #
  1076. *     WRITE SM TOTALS TO REPORT FILE.
  1077. #
  1078.  
  1079.       SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
  1080.       DO
  1081.         BEGIN  # FOR EACH SM #
  1082.         IF B<SM,1>SEL$SM EQ 0
  1083.         THEN
  1084.           BEGIN
  1085.           TEST SM;
  1086.           END
  1087.  
  1088.         TEMP$SM = SM;
  1089.  
  1090. #
  1091. *     CONVERT VALUES TO DISPLAY CODE AND PRINT THEM.
  1092. #
  1093.  
  1094.         RPSPACE(OUT$FETP,SP"SPACE",1);
  1095.         RPLINE(OUT$FETP,"**",2,2,1);
  1096.         RPLINE(OUT$FETP,TEMP$SM,5,1,1);
  1097.         RPLINE(OUT$FETP,"**",8,2,1);
  1098.  
  1099.         CHAR$10[0] = XCDD(SM$LOC[SM]);
  1100.         RPLINE(OUT$FETP,CHAR$R4[0],12,4,1);
  1101.  
  1102.         CHAR$10[0] = XCDD(SM$RES[SM]);
  1103.         RPLINE(OUT$FETP,CHAR$R4[0],18,4,1);
  1104.  
  1105.         CHAR$10[0] = XCDD(SM$AUSF[SM]);
  1106.         RPLINE(OUT$FETP,CHAR$R7[0],24,7,1);
  1107.  
  1108.         CHAR$10[0] = XCDD(SM$AULF[SM]);
  1109.         RPLINE(OUT$FETP,CHAR$R7[0],34,7,1);
  1110.  
  1111.         CHAR$10[0] = XCDD(SM$LOST[SM]);
  1112.         RPLINE(OUT$FETP,CHAR$R4[0],43,4,1);
  1113.  
  1114.         CHAR$10[0] = XCDD(SM$INH[SM]);
  1115.         RPLINE(OUT$FETP,CHAR$R4[0],49,4,1);
  1116.  
  1117.         CHAR$10[0] = XCDD(SM$FRC[SM]);
  1118.         RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
  1119.  
  1120.         CHAR$10[0] = XCDD(SM$OCL[SM]);
  1121.         RPLINE(OUT$FETP,CHAR$R4[0],61,4,1);
  1122.  
  1123.         CHAR$10[0] = XCDD(SM$XPE[SM]);
  1124.         RPLINE(OUT$FETP,CHAR$R4[0],67,4,1);
  1125.  
  1126.         CHAR$10[0] = XCDD(SM$SE[SM]);
  1127.         RPLINE(OUT$FETP,CHAR$R4[0],73,4,1);
  1128.  
  1129.         CHAR$10[0] = XCDD(SM$FB[SM]);
  1130.         RPLINE(OUT$FETP,CHAR$R7[0],81,7,1);
  1131.  
  1132.         CHAR$10[0] = XCDD(SM$FA[SM]);
  1133.         RPLINE(OUT$FETP,CHAR$R7[0],90,7,1);
  1134.  
  1135.         CHAR$10[0] = XCDD(SM$SF[SM]);
  1136.         RPLINE(OUT$FETP,CHAR$R7[0],99,7,1);
  1137.  
  1138.         CHAR$10[0] = XCDD(SM$FC[SM]);
  1139.         RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
  1140.  
  1141.         CHAR$10[0] = XCDD(SM$AUC[SM]);
  1142.         RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
  1143.         END  # FOR EACH SM #
  1144.  
  1145.       RPSPACE(OUT$FETP,SP"SPACE",2);
  1146.       RPLINE(OUT$FETP,"SUBFAMILY TOTALS FOR SPECIFIED SM-S",1,35,0);
  1147.  
  1148. #
  1149. *     WRITE SUBFAMILY TOTALS TO REPORT FILE.
  1150. #
  1151.  
  1152.       SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
  1153.       DO
  1154.         BEGIN  # FOR EACH SUBFAMILY #
  1155.         IF B<SUBFAM,1>SEL$SB EQ 0
  1156.         THEN
  1157.           BEGIN
  1158.           TEST SUBFAM;
  1159.           END
  1160.  
  1161. #
  1162. *     CONVERT VALUES TO DISPLAY CODE AND PRINT THEM.
  1163. #
  1164.  
  1165.         RPSPACE(OUT$FETP,SP"SPACE",1);
  1166.         CHAR$10[0] = XCDD(SUBFAM);
  1167.         RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
  1168.         RPLINE(OUT$FETP,"**",5,2,1);
  1169.         RPLINE(OUT$FETP,"**",8,2,1);
  1170.  
  1171.         CHAR$10[0] = XCDD(SF$LOC[SUBFAM]);
  1172.         RPLINE(OUT$FETP,CHAR$R4[0],12,4,1);
  1173.  
  1174.         CHAR$10[0] = XCDD(SF$RES[SUBFAM]);
  1175.         RPLINE(OUT$FETP,CHAR$R4[0],18,4,1);
  1176.  
  1177.         CHAR$10[0] = XCDD(SF$AUSF[SUBFAM]);
  1178.         RPLINE(OUT$FETP,CHAR$R7[0],24,7,1);
  1179.  
  1180.         CHAR$10[0] = XCDD(SF$AULF[SUBFAM]);
  1181.         RPLINE(OUT$FETP,CHAR$R7[0],34,7,1);
  1182.  
  1183.         CHAR$10[0] = XCDD(SF$LOST[SUBFAM]);
  1184.         RPLINE(OUT$FETP,CHAR$R4[0],43,4,1);
  1185.  
  1186.         CHAR$10[0] = XCDD(SF$INH[SUBFAM]);
  1187.         RPLINE(OUT$FETP,CHAR$R4[0],49,4,1);
  1188.  
  1189.         CHAR$10[0] = XCDD(SF$FRC[SUBFAM]);
  1190.         RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
  1191.  
  1192.         CHAR$10[0] = XCDD(SF$OCL[SUBFAM]);
  1193.         RPLINE(OUT$FETP,CHAR$R4[0],61,4,1);
  1194.  
  1195.         CHAR$10[0] = XCDD(SF$XPE[SUBFAM]);
  1196.         RPLINE(OUT$FETP,CHAR$R4[0],67,4,1);
  1197.  
  1198.         CHAR$10[0] = XCDD(SF$SE[SUBFAM]);
  1199.         RPLINE(OUT$FETP,CHAR$R4[0],73,4,1);
  1200.  
  1201.         CHAR$10[0] = XCDD(SF$FB[SUBFAM]);
  1202.         RPLINE(OUT$FETP,CHAR$R7[0],81,7,1);
  1203.  
  1204.         CHAR$10[0] = XCDD(SF$FA[SUBFAM]);
  1205.         RPLINE(OUT$FETP,CHAR$R7[0],90,7,1);
  1206.  
  1207.         CHAR$10[0] = XCDD(SF$SF[SUBFAM]);
  1208.         RPLINE(OUT$FETP,CHAR$R7[0],99,7,1);
  1209.  
  1210.         CHAR$10[0] = XCDD(SF$FC[SUBFAM]);
  1211.         RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
  1212.  
  1213.         CHAR$10[0] = XCDD(SF$AUC[SUBFAM]);
  1214.         RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
  1215.         END  # FOR EACH SUBFAMILY #
  1216.  
  1217.       RETURN;
  1218.  
  1219.       END  # USBASTOT #
  1220.  
  1221.     TERM
  1222. PROC USHEAD((FETP));
  1223. # TITLE USHEAD - WRITES HEADER ON OUTPUT FILE.                        #
  1224.  
  1225.       BEGIN  # USHEAD #
  1226.  
  1227. #
  1228. **    USHEAD - WRITES HEADER LINE ON OUTPUT FILE.
  1229. *
  1230. *     PROC USHEAD((FETP)).
  1231. *
  1232. *     ENTRY     (FETP) = AN ITEM CONTAINING THE FWA OF THE FET.
  1233. *
  1234. *     EXIT      HEADER IS WRITTEN ON THE OUTPUT FILE.
  1235. *
  1236. *     NOTES     THE REPORT FORMATTER IS USED TO
  1237. *               PRINT THE HEADER LINES.
  1238. #
  1239.  
  1240.       ITEM FETP       I;             # FWA OF THE FET #
  1241.  
  1242. #
  1243. ****  PROC USHEAD - XREF LIST BEGIN.
  1244. #
  1245.  
  1246.       XREF
  1247.         BEGIN
  1248.         PROC RPLINEX;                # PRINTS A REPORT LINE #
  1249.         END
  1250.  
  1251. #
  1252. ****  PROC USHEAD - XREF LIST END.
  1253. #
  1254.  
  1255.       DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
  1256. *CALL COMBFAS
  1257.  
  1258.                                                CONTROL EJECT;
  1259.  
  1260. #
  1261. *     PRINT THE HEADER LINE.
  1262. #
  1263.  
  1264.       RPLINEX(FETP,"SSUSE REPORT FILE",2,17,0);
  1265.       RPLINEX(FETP," ",1,1,0);       # WRITE A BLANK LINE #
  1266.       RETURN;
  1267.  
  1268.       END  # USHEAD #
  1269.  
  1270.     TERM
  1271. PROC USOPT;
  1272. # TITLE USOPT - CONVERTS PARAMETERS AND CHECKS FOR VALID OPTIONS.     #
  1273.  
  1274.       BEGIN  # USOPT #
  1275.  
  1276. #
  1277. **    USOPT - CONVERTS AND CHECKS PARAMETERS FOR ALL VALID OPTIONS.
  1278. *
  1279. *     THIS PROC CHECKS PARAMETERS FOR LEGALITY.  IF INVALID OPTIONS ARE
  1280. *     FOUND IT ISSUES A DAYFILE MESSAGE AND THEN ABORTS.
  1281. *
  1282. *     ENTRY     PARAMETERS PROCESSED AND SET UP IN *TUSPCOM*.
  1283. *
  1284. *     EXIT      ALL OPTIONS HAVE BEEN VALIDATED, OR IF VALID
  1285. *               OPTIONS HAVE BEEN MISUSED, THE PROC ISSUES A
  1286. *               DAYFILE MESSAGE AND THEN ABORTS.
  1287. *
  1288. *     MESSAGES  1)  INCORRECT SM.
  1289. *               2)  INCORRECT SUBFAMILY.
  1290. *               3)  INCORRECT REPORT OPTION.
  1291. *               4)  DUPLICATE SM.
  1292. *               5)  DUPLICATE SUBFAMILY.
  1293. *               6)  DUPLICATE OPTION.
  1294. *               7)  CN NOT SPECIFIED.
  1295. *
  1296. *     NOTES     ALL PARAMETER OPTIONS ARE TESTED FOR INVALID OPTIONS.
  1297. *               THE VALID OPTIONS ON *SSUSE* CALLS ARE
  1298. *                   1.  *OP* MUST EITHER CONTAIN ANY COMBINATION OF THE
  1299. *                       VALID CHARACTERS A, B, C, OR D, OR IT CAN BE
  1300. *                       OMITTED.
  1301. *                   2.  *SM* MUST BE A VALID SM NAME OR A VALID
  1302. *                       COMBINATION OF VALID SM NAMES, OR IT CAN BE
  1303. *                       OMITTED.
  1304. *                   3.  *SB* MUST BE FROM 0 TO 7 OR A VALID COMBINATION
  1305. *                       OF LEGAL SUBFAMILY NUMBERS, OR IT CAN BE OMITTED
  1306. *                   4.  *CN* MUST BE SPECIFIED IF REPORT D IS SELECTED.
  1307. *               ANY VIOLATION OF THE VALID OPTIONS CAUSES A MESSAGE
  1308. *               TO BE PRINTED IN THE DAYFILE AND CAUSES PROC
  1309. *               *USOPT* TO ABORT.
  1310. #
  1311.  
  1312. #
  1313. ****  PROC USOPT - XREF LIST BEGIN.
  1314. #
  1315.  
  1316.       XREF
  1317.         BEGIN
  1318.         PROC BZFILL;                 # BLANK FILLS CHARACTERS #
  1319.         PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
  1320.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  1321.                                        OR RETURN #
  1322.         END
  1323.  
  1324. #
  1325. ****  PROC USOPT - XREF LIST END.
  1326. #
  1327.  
  1328.       DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
  1329. *CALL COMBFAS
  1330. *CALL,COMBBZF
  1331. *CALL COMBMCT
  1332. *CALL COMXMSC
  1333. *CALL COMTUSE
  1334. *CALL COMTUSP
  1335.  
  1336.       ITEM I          I;             # LOOP VARIABLE #
  1337.       ITEM MORE       B;             # MORE SM-ID/SUBFAMILY INDICATOR #
  1338.       ITEM SMARG      C(10);         # SM ARGUMENTS #
  1339.       ITEM TEMPC      C(1);          # TEMPORARY CHARACTER #
  1340.  
  1341.                                                CONTROL EJECT;
  1342.  
  1343. #
  1344. *     CHECK ALL SPECIFIED VALUES OF *SM*.
  1345. #
  1346.  
  1347.       MORE = TRUE;
  1348.       SMARG = USARG$SM[0];
  1349.       BZFILL(SMARG,TYPFILL"BFILL",10);
  1350.       SLOWFOR I = 0 STEP 1 WHILE I LS MAXSM AND MORE
  1351.       DO
  1352.         BEGIN  # CHECK SPECIFIED SM-ID-S #
  1353.         TEMPC = C<I,1>SMARG;
  1354.         IF TEMPC EQ " "
  1355.         THEN                         # NO MORE SM-ID-S #
  1356.           BEGIN
  1357.           MORE = FALSE;
  1358.           TEST I;
  1359.           END
  1360.  
  1361.         IF TEMPC GR "H" OR TEMPC LS "A"
  1362.         THEN                         # INCORRECT SM #
  1363.           BEGIN
  1364.           SSMSG$LINE[0] = " INCORRECT SM.";
  1365.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1366.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  1367.           END
  1368.  
  1369.         IF B<TEMPC,1>SEL$SM EQ 1
  1370.         THEN                         # DUPLICATE SM #
  1371.           BEGIN
  1372.           SSMSG$LINE[0] = " DUPLICATE SM.";
  1373.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1374.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  1375.           END
  1376.  
  1377.         B<TEMPC,1>SEL$SM = 1;        # TURN SM BIT ON #
  1378.         END  # CHECK SPECIFIED SM-ID-S #
  1379.  
  1380. #
  1381. *     CHECK ALL SPECIFIED VALUES OF *SB*.
  1382. #
  1383.  
  1384.       MORE = TRUE;
  1385.       SLOWFOR I = 0 STEP 1 WHILE I LQ MAXSF AND MORE
  1386.       DO
  1387.         BEGIN  # CHECK SPECIFIED SUBFAMILIES #
  1388.         TEMPC = C<I,1>USARG$SB[0];
  1389.         IF TEMPC EQ 0
  1390.         THEN                         # NO MORE SUBFAMILIES #
  1391.           BEGIN
  1392.           MORE = FALSE;
  1393.           TEST I;
  1394.           END
  1395.  
  1396.         IF TEMPC LS "0" OR TEMPC GR "7"
  1397.         THEN                         # INCORRECT SUBFAMILY #
  1398.           BEGIN
  1399.           SSMSG$LINE[0] = " INCORRECT SUBFAMILY.";
  1400.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1401.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  1402.           END
  1403.  
  1404.         IF B<TEMPC - "0",1>SEL$SB EQ 1
  1405.         THEN                         # DUPLICATE SUBFAMILY #
  1406.           BEGIN
  1407.           SSMSG$LINE[0] = " DUPLICATE SUBFAMILY.";
  1408.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1409.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  1410.           END
  1411.  
  1412.         B<TEMPC - "0",1>SEL$SB = 1;  # TURN SUBFAMILY BIT ON #
  1413.         END  # CHECK SPECIFIED SUBFAMILIES #
  1414.  
  1415. #
  1416. *     CHECK THE VALUES OF *OP*.
  1417. #
  1418.  
  1419.       REPORT$A = FALSE;
  1420.       REPORT$B = FALSE;
  1421.       REPORT$C = FALSE;
  1422.       REPORT$D = FALSE;
  1423.  
  1424.       SLOWFOR I = 0 STEP 1 UNTIL 9
  1425.       DO
  1426.         BEGIN  # CHECK ALL VALUES OF *OP* #
  1427.         TEMPC = C<I,1>USARG$OP[0];
  1428.         IF TEMPC NQ 0
  1429.         THEN
  1430.           BEGIN  # CHECK SPECIFIED *OP* #
  1431.           IF TEMPC GR "D" OR TEMPC LS "A"
  1432.           THEN
  1433.             BEGIN
  1434.             SSMSG$LINE[0] = " INCORRECT REPORT OPTION.";
  1435.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1436.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  1437.             END
  1438.  
  1439.           ELSE
  1440.             BEGIN  # SET APPROPRIATE FLAG #
  1441.             IF TEMPC EQ "A"
  1442.             THEN                     # REPORT A SELECTED #
  1443.               BEGIN
  1444.               IF NOT REPORT$A
  1445.               THEN                   # UNIQUE OPTION #
  1446.                 BEGIN
  1447.                 REPORT$A = TRUE;
  1448.                 TEST I;
  1449.                 END
  1450.  
  1451.               ELSE                   # DUPLICATE OPTION #
  1452.                 BEGIN
  1453.                 SSMSG$LINE[0] = " DUPLICATE OPTION.";
  1454.                 MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1455.                 RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT #
  1456.                 END
  1457.  
  1458.               END
  1459.  
  1460.             IF TEMPC EQ "B"
  1461.             THEN                     # REPORT B SELECTED #
  1462.               BEGIN
  1463.               IF NOT REPORT$B
  1464.               THEN                   # UNIQUE OPTION #
  1465.                 BEGIN
  1466.                 REPORT$B = TRUE;
  1467.                 TEST I;
  1468.                 END
  1469.  
  1470.               ELSE                   # DUPLICATE OPTION #
  1471.                 BEGIN
  1472.                 SSMSG$LINE[0] = " DUPLICATE OPTION.";
  1473.                 MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1474.                 RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT #
  1475.                 END
  1476.  
  1477.               END
  1478.  
  1479.             IF TEMPC EQ "C"
  1480.             THEN                     # REPORT C SELECTED #
  1481.               BEGIN
  1482.               IF NOT REPORT$C
  1483.               THEN                   # UNIQUE OPTION #
  1484.                 BEGIN
  1485.                 REPORT$C = TRUE;
  1486.                 TEST I;
  1487.                 END
  1488.  
  1489.               ELSE                   # DUPLICATE OPTION #
  1490.                 BEGIN
  1491.                 SSMSG$LINE[0] = " DUPLICATE OPTION.";
  1492.                 MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1493.                 RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT #
  1494.                 END
  1495.  
  1496.               END
  1497.  
  1498.             IF TEMPC EQ "D"
  1499.             THEN                     # REPORT D SELECTED #
  1500.               BEGIN
  1501.               IF NOT REPORT$D
  1502.               THEN                   # UNIQUE OPTION #
  1503.                 BEGIN
  1504.                 REPORT$D = TRUE;
  1505.                 TEST I;
  1506.                 END
  1507.  
  1508.               ELSE                   # DUPLICATE OPTION #
  1509.                 BEGIN
  1510.                 SSMSG$LINE[0] = " DUPLICATE OPTION.";
  1511.                 MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1512.                 RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT #
  1513.                 END
  1514.  
  1515.               END
  1516.  
  1517.             END  # SET APPROPRIATE FLAG #
  1518.  
  1519.           END  # CHECK SPECIFIED *OP* #
  1520.  
  1521.         END  # CHECK ALL VALUES OF *OP* #
  1522.  
  1523. #
  1524. *     CHECK THAT *CN* IS SPECIFIED IF REPORT D IS SELECTED.
  1525. #
  1526.  
  1527.       IF REPORT$D
  1528.       THEN
  1529.         BEGIN  # CHECK *CN* #
  1530.         IF USARG$CN[0] EQ 0
  1531.         THEN
  1532.           BEGIN
  1533.           SSMSG$LINE[0] = " CN NOT SPECIFIED.";
  1534.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1535.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  1536.           END
  1537.  
  1538.         END  # CHECK *CN* #
  1539.  
  1540.       IF USARG$CM[0] NQ 0
  1541.       THEN
  1542.         BEGIN
  1543.         C<1,1>USARG$CM[0] = "-";
  1544.         END
  1545.  
  1546.       RETURN;
  1547.  
  1548.       END  # USOPT #
  1549.  
  1550.     TERM
  1551. PROC USRPBAS;
  1552. # TITLE USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS.     #
  1553.  
  1554.       BEGIN  # USRPBAS #
  1555.  
  1556. #
  1557. **    USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS.
  1558. *
  1559. *     THIS PROCEDURE GENERATES THE BASIC REPORT AND ANY OPTIONAL
  1560. *     REPORTS SELECTED FOR ALL THE SM-S AND SUBFAMILIES SPECIFIED.
  1561. *
  1562. *     PROC USRPBAS.
  1563. *
  1564. *     ENTRY     PROCESSED AND SYNTAX-CHECKED PARAMETERS SET UP IN
  1565. *               *TUSPCOM*.
  1566. *               (USARG$FM) = FAMILY NAME.
  1567. *               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
  1568. *               (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES.
  1569. *               (REPORT$A) = OPTIONAL REPORT SELECTION CODE,
  1570. *                              TRUE, REPORT A SELECTED,
  1571. *                              FALSE, REPORT A NOT SELECTED.
  1572. *               (REPORT$B) = OPTIONAL REPORT SELECTION CODE,
  1573. *                              TRUE, REPORT B SELECTED,
  1574. *                              FALSE, REPORT B NOT SELECTED.
  1575. *               (REPORT$C) = OPTIONAL REPORT SELECTION CODE,
  1576. *                              TRUE, REPORT C SELECTED,
  1577. *                              FALSE, REPORT C NOT SELECTED.
  1578. *               (REPORT$D) = OPTIONAL REPORT SELECTION CODE,
  1579. *                              TRUE, REPORT D SELECTED,
  1580. *                              FALSE, REPORT D NOT SELECTED.
  1581. *
  1582. *     EXIT      ALL SPECIFIED REPORTS HAVE BEEN GENERATED.
  1583. *
  1584. *     MESSAGES  1)  FAMILY NOT FOUND.
  1585. *               2)  UNABLE TO OPEN CATALOG.
  1586. *               3)  SSUSE ABNORMAL, USRPBAS.
  1587. *               4)  SFM CATALOG PARITY ERROR.
  1588. *
  1589. *     NOTES     *USRPBAS* GENERATES THE BASIC REPORT FOR ALL SM-S
  1590. *               SPECIFIED FOR ALL OF THE SUBFAMILIES SPECIFIED IN
  1591. *               THE BITS OF *SEL$SB*.  IF ANY OPTIONAL REPORTS
  1592. *               ARE DESIRED, *USRPBAS* CALLS THE APPROPRIATE ROUTINES
  1593. *               TO GENERATE THOSE REPORTS.
  1594. #
  1595.  
  1596. #
  1597. ****  PROC USRPBAS - XREF LIST BEGIN.
  1598. #
  1599.  
  1600.       XREF
  1601.         BEGIN
  1602.         PROC BZFILL;                 # BLANK FILLS CHARACTERS #
  1603.         PROC CCLOSE;                 # CLOSES THE CATALOG #
  1604.         PROC COPEN;                  # OPENS THE CATALOG #
  1605.         PROC LOFPROC;                # LIST OF FILES PROCESSOR #
  1606.         PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
  1607.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  1608.                                        OR RETURN #
  1609.         PROC RPCLOSE;                # CLOSES THE REPORT FILE #
  1610.         PROC RPEJECT;                # PAGE EJECTS THE REPORT FILE #
  1611.         PROC RPLINE;                 # WRITES LINE TO REPORT FILE #
  1612.         PROC RPOPEN;                 # OPENS THE REPORT FILE #
  1613.         PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE #
  1614.         PROC SETPFP;                 # SET FAMILY AND USER INDEX #
  1615.         PROC USANALS;                # ANALYZE *FCT* ENTRIES FOR A SM #
  1616.         PROC USBASLN;                # PRINTS LINE ON BASIC REPORT #
  1617.         PROC USBASTOT;               # PRINTS TOTAL ON BASIC REPORT #
  1618.         PROC USHEAD;                 # WRITES HEADER ON OUTPUT FILE #
  1619.         PROC USRPTA;                 # GENERATES OPTIONAL REPORT A #
  1620.         PROC USRPTB;                 # GENERATES OPTIONAL REPORT B #
  1621.         PROC USRPTC;                 # GENERATES OPTIONAL REPORT C #
  1622.         PROC USRPTD;                 # GENERATES OPTIONAL REPORT D #
  1623.         PROC ZFILL;                  # ZERO FILL ARRAY #
  1624.         FUNC XCDD  C(10);            # CONVERTS INTEGERS TO DISPLAY #
  1625.         END
  1626.  
  1627. #
  1628. ****  PROC USRPBAS - XREF LIST END.
  1629. #
  1630.  
  1631.       DEF PROCNAME #"USRPBAS."#;     # PROC NAME #
  1632.       DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
  1633. *CALL COMBFAS
  1634. *CALL COMBBZF
  1635. *CALL COMBCMD
  1636. *CALL COMBCMS
  1637. *CALL COMBMCT
  1638. *CALL COMBPFP
  1639. *CALL COMXMSC
  1640. *CALL COMSPFM
  1641. *CALL COMTOUT
  1642. *CALL COMTUSE
  1643. *CALL COMTUSP
  1644.  
  1645.       ITEM EJEC$FLAG  B;             # FLAG TO TEST FOR EJECT #
  1646.       ITEM FLAG       I;             # ERROR FLAG #
  1647.       ITEM GROUP      I;             # LOOP VARIABLE #
  1648.       ITEM SM         I;             # LOOP VARIABLE #
  1649.       ITEM SUBFAM     I;             # LOOP VARIABLE #
  1650.       ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
  1651.       ITEM TEMP$SM    C(1);          # SM CHARACTER #
  1652.  
  1653.       ARRAY OUT$FET [0:0] S(SFETL);;  # FET FOR OUTPUT FILE #
  1654.  
  1655.                                                CONTROL EJECT;
  1656.  
  1657. #
  1658. *     SET THE FET POINTER FOR THE OUTPUT FILE.
  1659. #
  1660.  
  1661.       IF USARG$LZ[0] EQ 0
  1662.       THEN                           # NO OUTPUT FILE #
  1663.         BEGIN
  1664.         OUT$FETP = 0;
  1665.         END
  1666.  
  1667.       ELSE                           # SET UP THE FWA OF THE FET #
  1668.         BEGIN
  1669.         OUT$FETP = LOC(OUT$FET[0]);
  1670.         END
  1671.  
  1672. #
  1673. *     OPEN THE OUTPUT FILE.
  1674. #
  1675.  
  1676.       RPOPEN(USARG$L[0],OUT$FETP,USHEAD);
  1677.  
  1678. #
  1679. *     CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
  1680. #
  1681.  
  1682.       TEMP$FAM = USARG$FM[0];
  1683.       BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  1684.  
  1685. #
  1686. *     GENERATE THE BASIC REPORT ON EACH SUBFAMILY SPECIFIED.
  1687. #
  1688.  
  1689.       EJEC$FLAG = FALSE;             # DO NOT EJECT ON FIRST PAGE #
  1690.       SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
  1691.       DO
  1692.         BEGIN  # PROCESS EACH SUBFAMILY #
  1693.         IF B<SUBFAM,1>SEL$SB EQ 0
  1694.         THEN                         # SUBFAMILY NOT SELECTED #
  1695.           BEGIN
  1696.           TEST SUBFAM;
  1697.           END
  1698.  
  1699. #
  1700. *     SWITCH TO THE SPECIFIED FAMILY AND USER INDEX FOR
  1701. *     THE SELECTED SUBFAMILY.
  1702. #
  1703.  
  1704.         PFP$WRD0[0] = 0;
  1705.         PFP$FAM[0] = USARG$FM[0];
  1706.         PFP$UI[0] = DEF$UI + SUBFAM;
  1707.         PFP$FG1[0] = TRUE;
  1708.         PFP$FG4[0] = TRUE;
  1709.         SETPFP(PFP[0]);
  1710.         IF PFP$STAT[0] NQ 0
  1711.         THEN                         # FAMILY NOT FOUND #
  1712.           BEGIN
  1713.           SSMSG$LINE[0] = " FAMILY NOT FOUND.";
  1714.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1715.           RPCLOSE(OUT$FETP);
  1716.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  1717.           END
  1718.  
  1719. #
  1720. *     OPEN THE CATALOG FOR THE SUBFAMILY AND CHECK THE RETURNED
  1721. *     ERROR STATUS.
  1722. #
  1723.  
  1724.         CHAR$10[0] = XCDD(SUBFAM);
  1725.         SFMCAT$LST[0] = CHAR$R1[0];
  1726.         COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
  1727.         IF FLAG EQ CMASTAT"NOERR"
  1728.         THEN
  1729.           BEGIN
  1730.           LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES #
  1731.           END
  1732.  
  1733.         IF FLAG NQ CMASTAT"NOERR"
  1734.         THEN
  1735.           BEGIN  # CHECK FOR ERROR TYPE #
  1736.           IF FLAG EQ CMASTAT"INTLK"  ##
  1737.             OR FLAG EQ CMASTAT"ATTERR"
  1738.           THEN
  1739.             BEGIN
  1740.             SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG.";
  1741.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1742.             RPCLOSE(OUT$FETP);
  1743.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  1744.             END
  1745.  
  1746.           IF FLAG EQ CMASTAT"CIOERR"
  1747.           THEN
  1748.             BEGIN
  1749.             SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  1750.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1751.             RPCLOSE(OUT$FETP);
  1752.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  1753.             END
  1754.  
  1755.           ELSE
  1756.             BEGIN
  1757.             SSMSG$PROC[0] = PROCNAME;
  1758.             MESSAGE(SSMSG[0],SYSUDF1);
  1759.             RPCLOSE(OUT$FETP);
  1760.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  1761.             END
  1762.  
  1763.           END  # CHECK FOR ERROR TYPE #
  1764.  
  1765. #
  1766. *     GENERATE BASIC REPORT DETAIL LINES FOR EACH SM SPECIFIED.
  1767. #
  1768.  
  1769.         SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
  1770.         DO
  1771.           BEGIN  # PROCESS EACH SM #
  1772.           IF B<SM,1>SEL$SM EQ 0
  1773.           THEN                       # SM NOT SELECTED #
  1774.             BEGIN
  1775.             TEST SM;
  1776.             END
  1777.  
  1778.           TEMP$SM = SM;
  1779.  
  1780. #
  1781. *     CLEAR THE SUB-TOTAL COUNTERS FOR EACH GROUP.
  1782. #
  1783.  
  1784.           ZFILL(GRP$TOT,8*MAXGP);
  1785.  
  1786.           IF EJEC$FLAG
  1787.           THEN                       # NOT FIRST PAGE #
  1788.             BEGIN
  1789.             RPEJECT(OUT$FETP);
  1790.             END
  1791.  
  1792. #
  1793. *     CHECK THE NUMBER OF *FCT* ENTRIES FOR THIS SM.  IF NONE, PRINT
  1794. *     AN APPROPRIATE MESSAGE AND PROCESS THE NEXT SPECIFIED SM.
  1795. #
  1796.  
  1797.           P<PREAMBLE> = PRMBADR;     # SET PREAMBLE TABLE ADDRESS #
  1798.           IF PRM$SCW1[SM] EQ 0
  1799.           THEN                       # SM NOT ASSIGNED TO SUBFAMILY #
  1800.             BEGIN
  1801.             RPLINE(OUT$FETP,"SM ",3,3,1);
  1802.             RPLINE(OUT$FETP,TEMP$SM,6,1,1);
  1803.             RPLINE(OUT$FETP," NOT ASSIGNED TO SUBFAMILY  .",7,29,1);
  1804.             CHAR$10[0] = XCDD(SUBFAM);
  1805.             RPLINE(OUT$FETP,CHAR$R1[0],34,1,0);
  1806.             RPSPACE(OUT$FETP,SP"SPACE",1);
  1807.             TEST SM;
  1808.             END
  1809.  
  1810. #
  1811. *     ANALYZE THE *AST* AND *FCT* ENTRIES FOR THE SELECTED SM.  SET UP
  1812. *     THE SUB-TOTALS COUNTERS.
  1813. #
  1814.  
  1815.           USANALS(SUBFAM,SM);
  1816.  
  1817. #
  1818. *     DISPLAY THE SUB-TOTALS COUNTERS ON THE REPORT FILE.
  1819. #
  1820.  
  1821.           USBASLN(SUBFAM,SM);
  1822.  
  1823.           END  # PROCESS EACH SM #
  1824.  
  1825. #
  1826. *     CLOSE THE SFM CATALOG.
  1827. #
  1828.  
  1829.         CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
  1830.         IF FLAG NQ CMASTAT"NOERR"
  1831.         THEN                         # UNABLE TO CLOSE CATALOG #
  1832.           BEGIN
  1833.           SSMSG$PROC[0] = PROCNAME;
  1834.           MESSAGE(SSMSG[0],SYSUDF1);
  1835.           RPCLOSE(OUT$FETP);
  1836.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  1837.           END
  1838.  
  1839.         ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER #
  1840.  
  1841.         END  # PROCESS EACH SUBFAMILY #
  1842.  
  1843. #
  1844. *     WRITE SM AND SUBFAMILY TOTALS TO REPORT FILE.
  1845. #
  1846.  
  1847.       USBASTOT;
  1848.  
  1849. #
  1850. *     CALL SPECIFIED OPTIONAL REPORTS.
  1851. #
  1852.  
  1853.       IF REPORT$A
  1854.       THEN                           # OPTIONAL REPORT A SPECIFIED #
  1855.         BEGIN
  1856.         USRPTA;
  1857.         END
  1858.  
  1859.       IF REPORT$B
  1860.       THEN                           # OPTIONAL REPORT B SPECIFIED #
  1861.         BEGIN
  1862.         USRPTB;
  1863.         END
  1864.  
  1865.       IF REPORT$C
  1866.       THEN                           # OPTIONAL REPORT C SPECIFIED #
  1867.         BEGIN
  1868.         USRPTC;
  1869.         END
  1870.  
  1871.       IF REPORT$D
  1872.       THEN                           # OPTIONAL REPORT D SPECIFIED #
  1873.         BEGIN
  1874.         USRPTD;
  1875.         END
  1876.  
  1877. #
  1878. *     CLOSE THE REPORT FILE.
  1879. #
  1880.  
  1881.       RPCLOSE(OUT$FETP);
  1882.  
  1883.       RETURN;
  1884.  
  1885.       END  # USRPBAS #
  1886.  
  1887.     TERM
  1888. PROC USRPTA;
  1889. # TITLE USRPTA - GENERATES OPTIONAL REPORT A.                         #
  1890.  
  1891.       BEGIN  # USRPTA #
  1892.  
  1893. #
  1894. **    USRPTA - GENERATES OPTIONAL REPORT A.
  1895. *
  1896. *     THIS PROC LISTS THE CONTENTS OF A STORAGE MODULE AS DESCRIBED
  1897. *     IN THE SMMAP.
  1898. *
  1899. *     PROC USRPTA.
  1900. *
  1901. *     ENTRY.    (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
  1902. *               (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
  1903. *
  1904. *     EXIT.     OPTIONAL REPORT A GENERATED.
  1905. *
  1906. *     MESSAGES. 1) SMMAP PARITY ERROR.
  1907. *               2) UNABLE TO OPEN SMMAP.
  1908. *               3) SSUSE ABNORMAL, USRPTA.
  1909. *               4) FAMILY NOT FOUND.
  1910. *
  1911. *     NOTES.    FOR EACH SELECTED SM, PROC *USRPTA* OPENS THE
  1912. *               CORRESPONDING SMMAP AND PRINTS THE CONTENTS
  1913. *               OF THE Y,Z COORDINATES.  THE COLUMN CONTAINING
  1914. *               THE DRD-S IS NOT REPORTED ON.  THIS REPORT IS FIFTEEN
  1915. *               PAGES LONG WITH 1 Z AND 22 Y COORDINATES
  1916. *               LISTED PER PAGE.
  1917. #
  1918.  
  1919. #
  1920. ****  PROC USRPTA - XREF LIST BEGIN.
  1921. #
  1922.  
  1923.       XREF
  1924.         BEGIN
  1925.         PROC BZFILL;                 # BLANK FILLS CHARACTERS #
  1926.         PROC LOFPROC;                # LIST OF FILES PROCESSOR #
  1927.         PROC MCLOSE;                 # CLOSES SMMAP #
  1928.         PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
  1929.         PROC MGETENT;                # GETS SMMAP ENTRY #
  1930.         PROC MOPEN;                  # OPENS SMMAP #
  1931.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  1932.                                        OR RETURN #
  1933.         PROC RPCLOSE;                # CLOSES THE REPORT FILE #
  1934.         PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
  1935.         PROC RPLINE;                 # WRITES LINE TO REPORT FILE #
  1936.         PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE #
  1937.         PROC SETPFP;                 # SET FAMILY AND USER INDEX #
  1938.         FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
  1939.         END
  1940.  
  1941. #
  1942. ****  PROC USRPTA - XREF LIST END.
  1943. #
  1944.  
  1945.       DEF PROCNAME #"USRPTA."#;      # PROC NAME #
  1946.       DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
  1947. *CALL COMBFAS
  1948. *CALL COMBBZF
  1949. *CALL COMBCMD
  1950. *CALL COMBCMS
  1951. *CALL COMBMAP
  1952. *CALL COMBMCT
  1953. *CALL COMBPFP
  1954. *CALL COMSPFM
  1955. *CALL COMTOUT
  1956. *CALL COMTUSE
  1957. *CALL COMTUSP
  1958.  
  1959.       ITEM FLAG       I;             # ERROR FLAG #
  1960.       ITEM GP         I;             # GROUP #
  1961.       ITEM GRT        I;             # GROUP ORDINAL #
  1962.       ITEM MAP$ORD    I;             # SMMAP ORDINAL #
  1963.       ITEM RPTFLAG    C(7);          # REPORT FLAG #
  1964.       ITEM SM         I;             # LOOP VARIABLE #
  1965.       ITEM SM$ADDR    I;             # ADDRESS OF SMMAP #
  1966.       ITEM TEMP$SM    C(1);          # SM CHARACTER #
  1967.       ITEM Y          I;             # LOOP VARIABLE #
  1968.       ITEM Z          I;             # LOOP VARIABLE #
  1969.  
  1970.       ARRAY SMMAP$NM [0:0] P(1);     # ARRAY TO BUILD SMMAP #
  1971.         BEGIN
  1972.         ITEM SMAP$NAME  C(00,00,07);  # SMMAP FILE NAME #
  1973.         ITEM SMAP$CHAR  C(00,00,05);  # FIRST FIVE CHARACTERS #
  1974.         ITEM SMAP$SMID  C(00,30,01);  # SM-ID #
  1975.         ITEM SMAP$Z     U(00,36,24) = [0];  # ZERO FILL FILE NAME #
  1976.         END
  1977.  
  1978.  
  1979.                                                CONTROL EJECT;
  1980.  
  1981. #
  1982. *     SET DEFAULT FAMILY AND USER INDEX.
  1983. #
  1984.  
  1985.       PFP$WRD0[0] =0;
  1986.       PFP$FAM[0] = DEF$FAM;
  1987.       PFP$UI[0] = DEF$UI;
  1988.       PFP$FG1[0] = TRUE;
  1989.       PFP$FG4[0] = TRUE;
  1990.       SETPFP(PFP[0]);
  1991.       IF PFP$STAT NQ 0
  1992.       THEN                           # FAMILY NOT FOUND #
  1993.         BEGIN
  1994.         SSMSG$LINE[0] = " FAMILY NOT FOUND.";
  1995.         MESSAGE(SSMSG$BUF[0],SYSUDF1);
  1996.         RPCLOSE(OUT$FETP);
  1997.         RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT #
  1998.         END
  1999.  
  2000. #
  2001. *     PROCESS EACH SPECIFIED SM.
  2002. #
  2003.  
  2004.       SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
  2005.       DO
  2006.         BEGIN  # PROCESS EACH SM #
  2007.         IF B<SM,1>SEL$SM EQ 0
  2008.         THEN                         # SM NOT SELECTED #
  2009.           BEGIN
  2010.           TEST SM;
  2011.           END
  2012.  
  2013.         TEMP$SM = SM;
  2014.         SMAP$SMID[0] = TEMP$SM;
  2015.         SMAP$CHAR[0] = SMMAP;
  2016.  
  2017. #
  2018. *     OPEN THE SMMAP AND CHECK THE RETURNED ERROR STATUS.
  2019. #
  2020.  
  2021.         MOPEN(SM,SMAP$NAME[0],"RM",FLAG);
  2022.         IF FLAG EQ CMASTAT"NOERR"
  2023.         THEN
  2024.           BEGIN
  2025.           LOFPROC(SMAP$NAME[0]);     # ADD LFN TO LIST OF FILES #
  2026.           END
  2027.  
  2028.         SM$ADDR = LOC(MAPBUFR[0]);
  2029.         P<SMUMAP> = SM$ADDR;
  2030.  
  2031.         IF FLAG NQ CMASTAT"NOERR"
  2032.         THEN
  2033.           BEGIN  # SMMAP NOT OPENED SUCCESSFULLY #
  2034.           IF FLAG EQ CMASTAT"CIOERR"
  2035.           THEN
  2036.             BEGIN
  2037.             SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
  2038.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2039.             RPCLOSE(OUT$FETP);
  2040.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2041.             END
  2042.  
  2043.           IF FLAG EQ CMASTAT"INTLK"  ##
  2044.             OR FLAG EQ CMASTAT"ATTERR"
  2045.           THEN
  2046.             BEGIN
  2047.             SSMSG$LINE[0] = " UNABLE TO OPEN SMMAP.";
  2048.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2049.             RPCLOSE(OUT$FETP);
  2050.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2051.             END
  2052.  
  2053.           ELSE
  2054.             BEGIN
  2055.             SSMSG$PROC[0] = PROCNAME;
  2056.             MESSAGE(SSMSG[0],SYSUDF1);
  2057.             RPCLOSE(OUT$FETP);
  2058.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2059.             END
  2060.  
  2061.           END  # SMMAP NOT OPENED SUCCESSFULLY #
  2062.  
  2063. #
  2064. *     PROCESS EACH Y,Z PAIR.
  2065. #
  2066.  
  2067.         SLOWFOR Z = 0 STEP 1 UNTIL MAX$Z
  2068.         DO
  2069.           BEGIN  # PROCESS EACH Z COORDINATE #
  2070.  
  2071. #
  2072. *     DO NOT PROCESS THE COLUMN CONTAINING THE DRD-S.
  2073. #
  2074.  
  2075.           IF Z EQ Z$NO$CUBE
  2076.           THEN
  2077.             BEGIN
  2078.             TEST Z;
  2079.             END
  2080.  
  2081. #
  2082. *     WRITE HEADER TO REPORT FILE.
  2083. #
  2084.  
  2085.             RPEJECT(OUT$FETP);
  2086.             RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT A - ",5,26,1);
  2087.             RPLINE(OUT$FETP,"STORAGE MODULE MAP FOR SM = ",31,28,1);
  2088.             RPLINE(OUT$FETP,TEMP$SM,59,1,0);
  2089.             RPSPACE(OUT$FETP,SP"SPACE",1);
  2090.             RPLINE(OUT$FETP,"FLAGS:",5,6,1);
  2091.             RPLINE(OUT$FETP,"P = CARTRIDGE EXISTS IN POOL",15,28,1);
  2092.             RPLINE(OUT$FETP,"S = RESERVED FOR SYSTEM USE",49,27,1);
  2093.             RPLINE(OUT$FETP,"C = RESERVED FOR CUSTOMER ",81,26,1);
  2094.             RPLINE(OUT$FETP,"ENGINEERING",107,11,0);
  2095.             RPLINE(OUT$FETP,"F = NOT ASSIGNED TO THIS FAMILY",15,31,1);
  2096.             RPLINE(OUT$FETP,"E = ERROR FLAG",49,14,1);
  2097.             RPLINE(OUT$FETP,"N = (Y,Z) DOES NOT EXIST",81,24,1);
  2098.             RPLINE(OUT$FETP," IN SMMAP",105,9,0);
  2099.             RPLINE(OUT$FETP,"R = RESERVED FOR ALTERNATE SMMAP",15,32,1);
  2100.             RPLINE(OUT$FETP,"GPORD = ORDINAL IN GROUP",81,24,0);
  2101.             RPSPACE(OUT$FETP,SP"SPACE",1);
  2102.             RPLINE(OUT$FETP,"Y     Z    CM  CSN",6,18,1);
  2103.             RPLINE(OUT$FETP,"FAMILY      SUBFAMILY",30,21,1);
  2104.             RPLINE(OUT$FETP,"GROUP    GPORD     FLAGS",56,24,0);
  2105.             RPSPACE(OUT$FETP,SP"SPACE",1);
  2106.  
  2107.           SLOWFOR Y = 0 STEP 1 UNTIL MAX$Y
  2108.           DO
  2109.             BEGIN  # PROCESS EACH Y COORDINATE #
  2110.  
  2111. #
  2112. *     CALCULATE THE ORDINAL OF THE SMMAP ENTRY.
  2113. #
  2114.  
  2115.             MAP$ORD = MAXORD - Z - (Y * 16);
  2116.  
  2117. #
  2118. *     GET THE SMMAP ENTRY AND CHECK THE RETURNED ERROR STATUS.
  2119. #
  2120.  
  2121.             MGETENT(SM,MAP$ORD,SM$ADDR,FLAG);
  2122.             IF FLAG NQ CMASTAT"NOERR"
  2123.             THEN
  2124.               BEGIN  # CHECK FOR TYPE OF ERROR #
  2125.               IF FLAG EQ CMASTAT"CIOERR"
  2126.               THEN
  2127.                 BEGIN
  2128.                 SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
  2129.                 MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2130.                 RPCLOSE(OUT$FETP);
  2131.                 RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT #
  2132.                 END
  2133.  
  2134.               ELSE
  2135.                 BEGIN
  2136.                 SSMSG$PROC[0] = PROCNAME;
  2137.                 MESSAGE(SSMSG[0],SYSUDF1);
  2138.                 RPCLOSE(OUT$FETP);
  2139.                 RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT #
  2140.                 END
  2141.  
  2142.               END  # CHECK FOR TYPE OF ERROR #
  2143.  
  2144. #
  2145. *     CHECK CARTRIDGE FLAGS AND SET THE APPROPRIATE CHARACTERS
  2146. *     INTO THE REPORT FLAG.
  2147. #
  2148.  
  2149.             RPTFLAG = "      ";
  2150.             IF CM$FLAG1[0]
  2151.             THEN
  2152.               BEGIN
  2153.               C<0,1>RPTFLAG = "E";
  2154.               END
  2155.  
  2156.             IF CM$CODE[0] EQ CUBSTAT"CEUSE"
  2157.             THEN                     # RESERVED FOR CUSTOMER ENGINEER #
  2158.               BEGIN
  2159.               C<1,1>RPTFLAG = "C";
  2160.               END
  2161.  
  2162.             IF CM$CODE[0] EQ CUBSTAT"SCRPOOL"
  2163.             THEN                     # ASSIGNED TO POOL #
  2164.               BEGIN
  2165.               C<2,1>RPTFLAG = "P";
  2166.               END
  2167.  
  2168.             IF CM$CODE[0] EQ CUBSTAT"SYSUSE"
  2169.             THEN                     # RESERVED FOR SYSTEM USE #
  2170.               BEGIN
  2171.               C<3,1>RPTFLAG = "S";
  2172.               END
  2173.  
  2174.             IF CM$CODE[0] EQ CUBSTAT"NOCUBE"
  2175.             THEN                     # NO CUBICLE AT THIS ORDINAL #
  2176.               BEGIN
  2177.               C<4,1>RPTFLAG = "N";
  2178.               END
  2179.  
  2180.             IF CM$FMLYNM[0] NQ USARG$FM[0]
  2181.             THEN                     # NOT IN THIS FAMILY #
  2182.               BEGIN
  2183.               C<5,1>RPTFLAG = "F";
  2184.               END
  2185.  
  2186.             IF CM$CODE[0] EQ CUBSTAT"ALTCSU"
  2187.             THEN                     # RESERVED FOR OTHER SMMAP #
  2188.               BEGIN
  2189.               C<6,1>RPTFLAG = "R";
  2190.               END
  2191.  
  2192. #
  2193. *     CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE
  2194. *     REPORT FILE.
  2195. #
  2196.  
  2197.             CHAR$10[0] = XCDD(Y);
  2198.             RPLINE(OUT$FETP,CHAR$R2[0],5,2,1);
  2199.  
  2200.             CHAR$10[0] = XCDD(Z);
  2201.             RPLINE(OUT$FETP,CHAR$R2[0],11,2,1);
  2202.  
  2203.             CHAR$10[0] = CM$CCOD[0];
  2204.             BZFILL(CHAR,TYPFILL"BFILL",10);
  2205.             RPLINE(OUT$FETP,CHAR$L2[0],17,2,1);
  2206.  
  2207.             CHAR$10[0] = CM$CSND[0];
  2208.             BZFILL(CHAR,TYPFILL"BFILL",10);
  2209.             RPLINE(OUT$FETP,CHAR$L8[0],19,8,1);
  2210.  
  2211.             CHAR$10[0] = CM$FMLYNM[0];
  2212.             BZFILL(CHAR,TYPFILL"BFILL",10);
  2213.             RPLINE(OUT$FETP,CHAR$L7[0],30,7,1);
  2214.  
  2215. #
  2216. *     DO NOT PRINT SUBFAMILY, GROUP, OR GROUP ORDINAL UNLESS THEY
  2217. *     HAVE BEEN ASSIGNED.
  2218. #
  2219.  
  2220.             IF CM$CODE[0] EQ CUBSTAT"SUBFAM"
  2221.             THEN
  2222.               BEGIN   # ASSIGNED TO SUBFAMILY #
  2223.               CHAR$10[0] = XCDD(CM$SUB[0]);
  2224.               RPLINE(OUT$FETP,CHAR$R1[0],46,1,1);
  2225.               IF CM$FCTORD[0] NQ 0
  2226.               THEN
  2227.                 BEGIN
  2228.                 GP = CM$FCTORD[0] / MAXGRT;
  2229.                 CHAR$10[0] = XCDD(GP);
  2230.                 RPLINE(OUT$FETP,CHAR$R2[0],57,2,1);
  2231.                 GRT = CM$FCTORD[0] - (GP * MAXGRT);
  2232.                 CHAR$10[0] = XCDD(GRT);
  2233.                 RPLINE(OUT$FETP,CHAR$R2[0],67,2,1);
  2234.                 END
  2235.  
  2236.               END   # ASSIGNED TO SUBFAMILY #
  2237.  
  2238.             RPLINE(OUT$FETP,RPTFLAG,74,7,0);
  2239.             END  # PROCESS EACH Y COORDINATE #
  2240.  
  2241.           END  # PROCESS EACH Z COORDINATE #
  2242.  
  2243. #
  2244. *     CLOSE THE SMMAP.
  2245. #
  2246.  
  2247.         MCLOSE(SM,FLAG);
  2248.         IF FLAG NQ CMASTAT"NOERR"
  2249.         THEN
  2250.           BEGIN
  2251.           SSMSG$PROC[0] = PROCNAME;
  2252.           MESSAGE(SSMSG[0],SYSUDF1);
  2253.           RPCLOSE(OUT$FETP);
  2254.           RESTPFP(PFP$ABORT);
  2255.           END
  2256.  
  2257.         END  # PROCESS EACH SM #
  2258.  
  2259.       RETURN;
  2260.  
  2261.       END  # USRPTA #
  2262.  
  2263.     TERM
  2264. PROC USRPTB;
  2265. # TITLE USRPTB - GENERATES OPTIONAL REPORT B.                         #
  2266.  
  2267.       BEGIN  # USRPTB #
  2268.  
  2269. #
  2270. **    USRPTB - GENERATES OPTIONAL REPORT B.
  2271. *
  2272. *     THIS PROC IDENTIFIES THE AVAILABLE AU ON EACH CARTRIDGE, THE
  2273. *     NUMBER OF FLAGGED AU ON EACH CARTRIDGE, AND THE FLAGS SET
  2274. *     FOR EACH CARTRIDGE IN THE SFMCATALOG.
  2275. *
  2276. *     PROC USRPTB.
  2277. *
  2278. *     ENTRY.    (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES.
  2279. *               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
  2280. *               (USARG$FM) = FAMILY NAME.
  2281. *
  2282. *     EXIT.     OPTIONAL REPORT B GENERATED.
  2283. *
  2284. *     MESSAGES. 1)  FAMILY NOT FOUND.
  2285. *               2)  UNABLE TO OPEN CATALOG.
  2286. *               3)  SFMCATALOG PARITY ERROR.
  2287. *               4)  SSUSE ABNORMAL, USRPTB.
  2288. *
  2289. *     NOTES.    PROC *USRPTB* LISTS GENERAL STATUS INFORMATION FOR
  2290. *               EACH CARTRIDGE IN THE SFMCATALOG.  THE NUMBER OF
  2291. *               AVAILABLE AU AND FLAGGED AU FOR EACH CARTRIDGE, AND
  2292. *               THE FLAGS SET FOR EACH CARTRIDGE ARE LISTED.
  2293. #
  2294.  
  2295. #
  2296. ****  PROC USRPTB - XREF LIST BEGIN.
  2297. #
  2298.  
  2299.       XREF
  2300.         BEGIN
  2301.         PROC BZFILL;                 # BLANK FILLS CHARACTERS #
  2302.         PROC CCLOSE;                 # CLOSES CATALOG #
  2303.         PROC CGETFCT;                # GETS AN *FCT* ENTRY #
  2304.         PROC COPEN;                  # OPENS CATALOG #
  2305.         PROC CRDAST;                 # READS *AST* #
  2306.         PROC LOFPROC;                # LIST OF FILES PROCESSOR #
  2307.         PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
  2308.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  2309.                                        OR RETURN #
  2310.         PROC RPCLOSE;                # CLOSES THE REPORT FILE #
  2311.         PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
  2312.         PROC RPLINE;                 # WRITES LINE TO REPORT FILE #
  2313.         PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE #
  2314.         PROC SETPFP;                 # SET FAMILY AND USER INDEX #
  2315.         PROC ZFILL;                  # ZERO FILL ARRAY #
  2316.         FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
  2317.         END
  2318.  
  2319. #
  2320. ****  PROC USRPTB - XREF LIST END.
  2321. #
  2322.  
  2323.       DEF PROCNAME #"USRPTB."#;      # PROC NAME #
  2324.       DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
  2325. *CALL COMBFAS
  2326. *CALL COMBBZF
  2327. *CALL COMBCMD
  2328. *CALL COMBCMS
  2329. *CALL COMBMCT
  2330. *CALL COMBPFP
  2331. *CALL COMSPFM
  2332. *CALL COMXMSC
  2333. *CALL COMTOUT
  2334. *CALL COMTUSE
  2335. *CALL COMTUSP
  2336.  
  2337.       ITEM ACFLAG     I;             # AU CONFLICT COUNT #
  2338.       ITEM ASTADR     I;             # *AST* BUFFER ADDRESS #
  2339.       ITEM FAFLAG     I;             # FLAWED,ALLOCATED AU COUNT #
  2340.       ITEM FCFLAG     I;             # FROZEN CHAIN AU COUNT #
  2341.       ITEM FCTADR     I;             # *FCT* BUFFER ADDRESS #
  2342.       ITEM FLAG       I;             # ERROR FLAG #
  2343.       ITEM FUFLAG     I;             # FLAWED,UNALLOCATED AU COUNT #
  2344.       ITEM GP         I;             # GROUP #
  2345.       ITEM GRT        I;             # GROUP ORDINAL #
  2346.       ITEM J          I;             # LOOP VARIABLE #
  2347.       ITEM LN$CNT     I;             # COUNT OF PRINTED LINES #
  2348.       ITEM N          I;             # LOOP VARIABLE #
  2349.       ITEM RPTFLAG    C(6);          # REPORT FLAG #
  2350.       ITEM SFFLAG     I;             # START OF FRAGMENT AU COUNT #
  2351.       ITEM SM         I;             # LOOP VARIABLE #
  2352.       ITEM SUBFAM     I;             # LOOP VARIABLE #
  2353.       ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
  2354.       ITEM TEMP$SM    C(1);          # SM CHARACTER #
  2355.                                                CONTROL EJECT;
  2356.  
  2357.       FCTADR = LOC(US$FCTENT[0]);
  2358.       ASTADR = LOC(US$ASTENT[0]);
  2359.  
  2360. #
  2361. *     CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
  2362. #
  2363.  
  2364.       TEMP$FAM = USARG$FM[0];
  2365.       BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  2366.  
  2367. #
  2368. *     CHECK IF SUBFAMILY SELECTED.
  2369. #
  2370.  
  2371.       SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
  2372.       DO
  2373.         BEGIN  # PROCESS EACH SUBFAMILY #
  2374.         IF B<SUBFAM,1>SEL$SB EQ 0
  2375.         THEN                         # SUBFAMILY NOT SELECTED #
  2376.           BEGIN
  2377.           TEST SUBFAM;
  2378.           END
  2379.  
  2380. #
  2381. *     SET THE FAMILY AND USER INDEX.
  2382. #
  2383.  
  2384.         PFP$WRD0[0] = 0;
  2385.         PFP$FAM[0] = USARG$FM[0];
  2386.         PFP$UI[0] = DEF$UI + SUBFAM;
  2387.         PFP$FG1[0] = TRUE;
  2388.         PFP$FG4[0] = TRUE;
  2389.         SETPFP(PFP[0]);
  2390.         IF PFP$STAT[0] NQ 0
  2391.         THEN                         # FAMILY NOT FOUND #
  2392.           BEGIN
  2393.           SSMSG$LINE[0] = " FAMILY NOT FOUND.";
  2394.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2395.           RPCLOSE(OUT$FETP);
  2396.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  2397.           END
  2398.  
  2399. #
  2400. *     OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS.
  2401. #
  2402.  
  2403.         CHAR$10[0] = XCDD(SUBFAM);
  2404.         SFMCAT$LST[0] = CHAR$R1[0];
  2405.         COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
  2406.         IF FLAG EQ CMASTAT"NOERR"
  2407.         THEN
  2408.           BEGIN
  2409.           LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES #
  2410.           END
  2411.  
  2412.         IF FLAG NQ CMASTAT"NOERR"
  2413.         THEN
  2414.           BEGIN  # CHECK FOR TYPE OF ERROR #
  2415.           IF FLAG EQ CMASTAT"INTLK"  ##
  2416.             OR FLAG EQ CMASTAT"ATTERR"
  2417.           THEN
  2418.             BEGIN
  2419.             SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG.";
  2420.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2421.             RPCLOSE(OUT$FETP);
  2422.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2423.             END
  2424.  
  2425.           IF FLAG EQ CMASTAT"CIOERR"
  2426.           THEN
  2427.             BEGIN
  2428.             SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  2429.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2430.             RPCLOSE(OUT$FETP);
  2431.             RESTPFP(PFP$ABORT);
  2432.             END
  2433.  
  2434.           ELSE
  2435.             BEGIN
  2436.             SSMSG$PROC[0] = PROCNAME;
  2437.             MESSAGE(SSMSG[0],SYSUDF1);
  2438.             RPCLOSE(OUT$FETP);
  2439.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2440.             END
  2441.  
  2442.           END  # CHECK FOR TYPE OF ERROR #
  2443.  
  2444. #
  2445. *     CHECK IF SM ASSIGNED TO SUBFAMILY.
  2446. #
  2447.  
  2448.         SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
  2449.         DO
  2450.           BEGIN  # CHECK EACH SELECTED SM #
  2451.           IF B<SM,1>SEL$SM EQ 0
  2452.           THEN                       # SM NOT SELECTED #
  2453.             BEGIN
  2454.             TEST SM;
  2455.             END
  2456.  
  2457.           P<PREAMBLE> = PRMBADR;
  2458.           LN$CNT = MAX$LN + 1;       # INITIALIZE LINE COUNT #
  2459.  
  2460. #
  2461. *     IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM.
  2462. #
  2463.  
  2464.           IF PRM$SCW1[SM] EQ 0
  2465.           THEN                       # SM NOT ASSIGNED TO SUBFAMILY #
  2466.             BEGIN
  2467.             TEST SM;
  2468.             END
  2469.  
  2470. #
  2471. *     GET THE *AST* AND CHECK THE RETURNED ERROR STATUS.
  2472. #
  2473.  
  2474.           CRDAST(USARG$FM[0],SUBFAM,SM,ASTADR,0,FLAG);
  2475.           IF FLAG NQ CMASTAT"NOERR"
  2476.           THEN                       # UNABLE TO GET *AST* #
  2477.             BEGIN
  2478.             SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  2479.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2480.             RPCLOSE(OUT$FETP);
  2481.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2482.             END
  2483.  
  2484.           P<AST> = ASTADR;
  2485.  
  2486. #
  2487. *     PROCESS ALL *AST* AND *FCT* ENTRIES.
  2488. #
  2489.  
  2490.           SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
  2491.           DO
  2492.             BEGIN  # PROCESS AN *AST* AND *FCT* ENTRY #
  2493.  
  2494. #
  2495. *     GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
  2496. #
  2497.  
  2498.             CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG);
  2499.             IF FLAG NQ CMASTAT"NOERR"
  2500.             THEN                     # UNABLE TO GET *FCT* #
  2501.               BEGIN
  2502.               SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  2503.               MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2504.               RPCLOSE(OUT$FETP);
  2505.               RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT #
  2506.               END
  2507.  
  2508.             P<FCT> = FCTADR;
  2509.  
  2510. #
  2511. *     CHECK THE CUBICLE STATUS.  IF IT DOES NOT CONTAIN A
  2512. *     CARTRIDGE GO TO NEXT CUBICLE.
  2513. #
  2514.  
  2515.             IF FCT$CSND[0] EQ "   "
  2516.               OR FCT$CSNI[0] EQ 0
  2517.             THEN                     # NO CARTRIDGE AT THIS LOCATION #
  2518.               BEGIN
  2519.               TEST J;
  2520.               END
  2521.  
  2522. #
  2523. *     WRITE HEADER TO REPORT FILE IF NEW PAGE.
  2524. #
  2525.  
  2526.             IF LN$CNT GQ MAX$LN
  2527.             THEN                     # PAGE EJECT AND PRINT HEADER #
  2528.               BEGIN
  2529.               TEMP$SM = SM;
  2530.               RPEJECT(OUT$FETP);
  2531.               RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT B - ",5,26,1);
  2532.               RPLINE(OUT$FETP,"CARTRIDGE SUMMARY REPORT",31,24,1);
  2533.               RPLINE(OUT$FETP,"SM = ",58,5,1);
  2534.               RPLINE(OUT$FETP,TEMP$SM,63,1,1);
  2535.               RPLINE(OUT$FETP,"SUBFAMILY = ",67,12,1);
  2536.               CHAR$10[0] = XCDD(SUBFAM);
  2537.               RPLINE(OUT$FETP,CHAR$R1[0],79,1,1);
  2538.               RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
  2539.               RPLINE(OUT$FETP,TEMP$FAM,93,7,0);
  2540.               RPSPACE(OUT$FETP,SP"SPACE",1);
  2541.  
  2542. #
  2543. *     PRINT NOTES AND COLUMN HEADINGS.
  2544. #
  2545.  
  2546.               RPLINE(OUT$FETP,"NOTES:",5,6,1);
  2547.               RPLINE(OUT$FETP,"CARTRIDGE FLAGS:",46,16,0);
  2548.               RPLINE(OUT$FETP,"FA = FLAWED AND ALLOCATED",7,25,1);
  2549.               RPLINE(OUT$FETP,"M = MISSING",48,11,0);
  2550.               RPLINE(OUT$FETP,"FU = FLAWED AND UNALLOCATED",7,27,1);
  2551.               RPLINE(OUT$FETP,"I = INHIBIT",48,11,0);
  2552.               RPLINE(OUT$FETP,"SF = START OF FRAGMENT",7,22,1);
  2553.               RPLINE(OUT$FETP,"F = FREE CARTRIDGE",48,18,0);
  2554.               RPLINE(OUT$FETP,"FC = FROZEN CHAIN",7,17,1);
  2555.               RPLINE(OUT$FETP,"L = LINK(FREE AU EXIST, ",48,24,1);
  2556.               RPLINE(OUT$FETP,"NO OFF CARTRIDGE LINK)",72,22,0);
  2557.               RPLINE(OUT$FETP,"AC = AU CONFLICT",7,16,1);
  2558.               RPLINE(OUT$FETP,"P = EXCESSIVE WRITE ERRORS",48,26,0);
  2559.               RPLINE(OUT$FETP,"GPORD = ORDINAL IN GROUP",7,24,1);
  2560.               RPLINE(OUT$FETP,"E = MAP ERROR",48,13,1);
  2561.               RPLINE(OUT$FETP,"(DETECTED BY SSVAL)",61,19,0);
  2562.               RPSPACE(OUT$FETP,SP"SPACE",1);
  2563.               RPLINE(OUT$FETP,"------ERROR CONDITIONS------",60,28,0);
  2564.               RPLINE(OUT$FETP,"FREE AU      CART",39,17,1);
  2565.               RPLINE(OUT$FETP,"--------NUMBER OF AU--------",60,28,0);
  2566.               RPLINE(OUT$FETP,"GP  GPORD   Y",5,13,1);
  2567.               RPLINE(OUT$FETP,"Z   CM  CSN",21,11,1);
  2568.               RPLINE(OUT$FETP,"SMALL   LARGE   FLAGS",36,21,1);
  2569.               RPLINE(OUT$FETP,"FA    FU    SF",62,14,1);
  2570.               RPLINE(OUT$FETP,"FC    AC",80,8,0);
  2571.               RPSPACE(OUT$FETP,SP"SPACE",1);
  2572.               LN$CNT = 17;
  2573.               END
  2574.  
  2575. #
  2576. *     CHECK FOR FLAGS AND SET THE APPROPRIATE CHARACTERS INTO THE
  2577. *     REPORT FLAG.
  2578. #
  2579.  
  2580.             RPTFLAG = "      ";
  2581.             IF FCT$LCF[0]
  2582.             THEN                     # CARTRIDGE MISSING #
  2583.               BEGIN
  2584.               C<1,1>RPTFLAG = "M";
  2585.               END
  2586.  
  2587.             IF FCT$IAF[0]
  2588.             THEN                     # INHIBIT ALLOCATION #
  2589.               BEGIN
  2590.               C<2,1>RPTFLAG = "I";
  2591.               END
  2592.  
  2593.             IF FCT$FCF[0]
  2594.             THEN                     # FREE CARTRIDGE #
  2595.               BEGIN
  2596.               C<3,1>RPTFLAG = "F";
  2597.               END
  2598.  
  2599.             IF AST$AULF[J] GR 0      ##
  2600.               OR AST$AUSF[J] GR 0
  2601.             THEN                     # FREE AU EXIST #
  2602.               BEGIN
  2603.               IF FCT$OCLF[0] EQ 7
  2604.               THEN                   # NO LINKS AVAILABLE #
  2605.                 BEGIN
  2606.                 C<4,1>RPTFLAG = "L";
  2607.                 END
  2608.  
  2609.               END
  2610.  
  2611.             IF FCT$EEF[0]
  2612.             THEN                     # EXCESSIVE PARITY ERRORS #
  2613.               BEGIN
  2614.               C<5,1>RPTFLAG = "P";
  2615.               END
  2616.  
  2617.             IF FCT$SEF[0]
  2618.             THEN                     # SMMAP ERROR FLAG SET #
  2619.               BEGIN
  2620.               C<0,1>RPTFLAG = "E";
  2621.               END
  2622.  
  2623. #
  2624. *     PROCESS EACH AU.  CHECK FOR ERRORS AND UPDATE THE APPROPRIATE
  2625. *     COUNTERS.
  2626. #
  2627.  
  2628.             ACFLAG = 0;
  2629.             FAFLAG = 0;
  2630.             FCFLAG = 0;
  2631.             FUFLAG = 0;
  2632.             SFFLAG = 0;
  2633.  
  2634.             SLOWFOR N = 1 STEP 1 UNTIL INAVOT
  2635.             DO
  2636.               BEGIN  # PROCESS EACH AU #
  2637.  
  2638.               SETFCTX(N);            # SET *FWD* AND *FPS* VALUES #
  2639.  
  2640.               IF FCT$FAUF(FWD,FPS) NQ 0
  2641.               THEN                   # FLAWED AU #
  2642.                 BEGIN
  2643.                 IF FCT$FBF(FWD,FPS) EQ 0
  2644.                 THEN                 # FLAWED AND UNALLOCATED #
  2645.                   BEGIN
  2646.                   FUFLAG = FUFLAG + 1;
  2647.                   END
  2648.  
  2649.                 ELSE                 # FLAWED AND ALLOCATED #
  2650.                   BEGIN
  2651.                   FAFLAG = FAFLAG + 1;
  2652.                   END
  2653.  
  2654.                 END
  2655.  
  2656.               IF FCT$SFF(FWD,FPS) NQ 0
  2657.               THEN
  2658.                 BEGIN
  2659.                 SFFLAG = SFFLAG + 1;  # START OF FRAGMENT #
  2660.                 END
  2661.  
  2662.               IF FCT$FRCF(FWD,FPS) NQ 0
  2663.               THEN
  2664.                 BEGIN
  2665.                 FCFLAG = FCFLAG + 1;  # FROZEN CHAIN #
  2666.                 END
  2667.  
  2668.               IF FCT$AUCF(FWD,FPS) NQ 0
  2669.               THEN
  2670.                 BEGIN
  2671.                 ACFLAG = ACFLAG + 1;  # AU CONFLICT #
  2672.                 END
  2673.  
  2674.               END  # PROCESS EACH AU #
  2675.  
  2676. #
  2677. *     CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE REPORT
  2678. *     FILE.  BLANK FILL CSN AND CARTRIDGE MANUFACTURER CODE.
  2679. #
  2680.  
  2681.             GP = J / MAXGRT;
  2682.             CHAR$10[0] = XCDD(GP);
  2683.             RPLINE(OUT$FETP,CHAR$R2[0],5,2,1);
  2684.  
  2685.             GRT = J - (GP * MAXGRT);
  2686.             CHAR$10[0] = XCDD(GRT);
  2687.             RPLINE(OUT$FETP,CHAR$R2[0],10,2,1);
  2688.  
  2689.             CHAR$10[0] = XCDD(FCT$Y[0]);
  2690.             RPLINE(OUT$FETP,CHAR$R2[0],16,2,1);
  2691.  
  2692.             CHAR$10[0] = XCDD(FCT$Z[0]);
  2693.             RPLINE(OUT$FETP,CHAR$R2[0],20,2,1);
  2694.  
  2695.             CHAR$10[0] = FCT$CCOD[0];
  2696.             BZFILL(CHAR,TYPFILL"BFILL",10);
  2697.             RPLINE(OUT$FETP,CHAR$L2[0],25,2,1);
  2698.  
  2699.             CHAR$10[0] = FCT$CSND[0];
  2700.             BZFILL(CHAR,TYPFILL"BFILL",10);
  2701.             RPLINE(OUT$FETP,CHAR$L8[0],27,8,1);
  2702.  
  2703.             CHAR$10[0] = XCDD(AST$AUSF[J]);
  2704.             RPLINE(OUT$FETP,CHAR$R4[0],37,4,1);
  2705.  
  2706.             CHAR$10[0] = XCDD(AST$AULF[J]);
  2707.             RPLINE(OUT$FETP,CHAR$R4[0],44,4,1);
  2708.  
  2709.             RPLINE(OUT$FETP,RPTFLAG,51,6,1);
  2710.  
  2711.             CHAR$10[0] = XCDD(FAFLAG);
  2712.             RPLINE(OUT$FETP,CHAR$R4[0],60,4,1);
  2713.  
  2714.             CHAR$10[0] = XCDD(FUFLAG);
  2715.             RPLINE(OUT$FETP,CHAR$R4[0],66,4,1);
  2716.  
  2717.             CHAR$10[0] = XCDD(SFFLAG);
  2718.             RPLINE(OUT$FETP,CHAR$R4[0],72,4,1);
  2719.  
  2720.             CHAR$10[0] = XCDD(FCFLAG);
  2721.             RPLINE(OUT$FETP,CHAR$R4[0],78,4,1);
  2722.  
  2723.             CHAR$10[0] = XCDD(ACFLAG);
  2724.             RPLINE(OUT$FETP,CHAR$R4[0],84,4,0);
  2725.             LN$CNT = LN$CNT + 1;     # INCREMENT LINE COUNT #
  2726.  
  2727.             END  # PROCESS AN *AST* AND *FCT* ENTRY #
  2728.  
  2729.           END  # CHECK EACH SELECTED SM #
  2730.  
  2731. #
  2732. *     CLOSE THE CATALOG.
  2733. #
  2734.  
  2735.         CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
  2736.         IF FLAG NQ CMASTAT"NOERR"
  2737.         THEN                         # UNABLE TO CLOSE CATALOG #
  2738.           BEGIN
  2739.           SSMSG$PROC[0] = PROCNAME;
  2740.           MESSAGE(SSMSG[0],SYSUDF1);
  2741.           RPCLOSE(OUT$FETP);
  2742.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  2743.           END
  2744.  
  2745.         ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER #
  2746.  
  2747.         END  # PROCESS EACH SUBFAMILY #
  2748.  
  2749.       RETURN;
  2750.  
  2751.       END  # USRPTB #
  2752.  
  2753.     TERM
  2754. PROC USRPTC;
  2755. # TITLE USRPTC - GENERATES OPTIONAL REPORT C.                         #
  2756.  
  2757.       BEGIN  # USRPTC #
  2758.  
  2759. #
  2760. **    USRPTC - GENERATES OPTIONAL REPORT C.
  2761. *
  2762. *     THIS PROC LISTS CARTRIDGE USAGE INFORMATION FOR EACH ENTRY
  2763. *     IN THE SFMCATALOG.
  2764. *
  2765. *     PROC USRPTC.
  2766. *
  2767. *     ENTRY.    (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES.
  2768. *               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
  2769. *               (USARG$FM) = FAMILY NAME.
  2770. *
  2771. *     EXIT.     OPTIONAL REPORT C GENERATED.
  2772. *
  2773. *     MESSAGES. 1)  FAMILY NOT FOUND.
  2774. *               2)  UNABLE TO OPEN CATALOG.
  2775. *               3)  SFMCATALOG PARITY ERROR.
  2776. *               4)  SSUSE ABNORMAL, USRPTC.
  2777. #
  2778.  
  2779. #
  2780. ****  PROC USRPTC - XREF LIST BEGIN.
  2781. #
  2782.  
  2783.       XREF
  2784.         BEGIN
  2785.         PROC BZFILL;                 # BLANK FILLS CHARACTERS #
  2786.         PROC CCLOSE;                 # CLOSES CATALOG #
  2787.         PROC CGETFCT;                # GETS AN *FCT* ENTRY #
  2788.         PROC COPEN;                  # OPENS CATALOG #
  2789.         PROC LOFPROC;                # LIST OF FILES PROCESSOR #
  2790.         PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
  2791.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  2792.                                        OR RETURN #
  2793.         PROC RPCLOSE;                # CLOSES THE REPORT FILE #
  2794.         PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
  2795.         PROC RPLINE;                 # WRITES LINE TO REPORT FILE #
  2796.         PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE #
  2797.         PROC SETPFP;                 # SET FAMILY AND USER INDEX #
  2798.         PROC ZFILL;                  # ZERO FILL ARRAY #
  2799.         FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
  2800.         END
  2801.  
  2802. #
  2803. ****  PROC USRPTC - XREF LIST END.
  2804. #
  2805.  
  2806.       DEF PROCNAME #"USRPTC."#;      # PROC NAME #
  2807.       DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
  2808. *CALL COMBFAS
  2809. *CALL COMBBZF
  2810. *CALL COMBCMD
  2811. *CALL COMBCMS
  2812. *CALL COMBMCT
  2813. *CALL COMBPFP
  2814. *CALL COMSPFM
  2815. *CALL COMXMSC
  2816. *CALL COMTOUT
  2817. *CALL COMTUSE
  2818. *CALL COMTUSP
  2819.  
  2820.       ITEM FCTADR     I;             # *FCT* BUFFER ADDRESS #
  2821.       ITEM FLAG       I;             # ERROR FLAG #
  2822.       ITEM GP         I;             # GROUP #
  2823.       ITEM J          I;             # LOOP VARIABLE #
  2824.       ITEM LN$CNT     I;             # COUNT OF PRINTED LINES #
  2825.       ITEM OCL        I;             # AVAILABLE LINK COUNT #
  2826.       ITEM RPTFLAG    C(4);          # REPORT FLAG #
  2827.       ITEM SM         I;             # LOOP VARIABLE #
  2828.       ITEM SUBFAM     I;             # LOOP VARIABLE #
  2829.       ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
  2830.       ITEM TEMP$SM    C(1);          # SM CHARACTER #
  2831.  
  2832.                                                CONTROL EJECT;
  2833.  
  2834.       FCTADR = LOC(US$FCTENT[0]);
  2835.  
  2836. #
  2837. *     CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
  2838. #
  2839.  
  2840.       TEMP$FAM = USARG$FM[0];
  2841.       BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  2842.  
  2843. #
  2844. *     CHECK IF SUBFAMILY SELECTED.
  2845. #
  2846.  
  2847.       SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
  2848.       DO
  2849.         BEGIN  # PROCESS EACH SUBFAMILY #
  2850.         IF B<SUBFAM,1>SEL$SB EQ 0
  2851.         THEN                         # SUBFAMILY NOT SELECTED #
  2852.           BEGIN
  2853.           TEST SUBFAM;
  2854.           END
  2855.  
  2856. #
  2857. *     SET THE FAMILY AND USER INDEX.
  2858. #
  2859.  
  2860.         PFP$WRD0[0] = 0;
  2861.         PFP$FAM[0] = USARG$FM[0];
  2862.         PFP$UI[0] = DEF$UI + SUBFAM;
  2863.         PFP$FG1[0] = TRUE;
  2864.         PFP$FG4[0] = TRUE;
  2865.         SETPFP(PFP[0]);
  2866.         IF PFP$STAT[0] NQ 0
  2867.         THEN                         # FAMILY NOT FOUND #
  2868.           BEGIN
  2869.           SSMSG$LINE[0] = " FAMILY NOT FOUND.";
  2870.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2871.           RPCLOSE(OUT$FETP);
  2872.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  2873.           END
  2874.  
  2875. #
  2876. *     OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS.
  2877. #
  2878.  
  2879.         CHAR$10[0] = XCDD(SUBFAM);
  2880.         SFMCAT$LST[0] = CHAR$R1[0];
  2881.         COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
  2882.         IF FLAG EQ CMASTAT"NOERR"
  2883.         THEN
  2884.           BEGIN
  2885.           LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES #
  2886.           END
  2887.  
  2888.         IF FLAG NQ CMASTAT"NOERR"
  2889.         THEN
  2890.           BEGIN  # CHECK FOR TYPE OF ERROR #
  2891.           IF FLAG EQ CMASTAT"INTLK"  ##
  2892.             OR FLAG EQ CMASTAT"ATTERR"
  2893.           THEN
  2894.             BEGIN
  2895.             SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG.";
  2896.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2897.             RPCLOSE(OUT$FETP);
  2898.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2899.             END
  2900.  
  2901.           IF FLAG EQ CMASTAT"CIOERR"
  2902.           THEN
  2903.             BEGIN
  2904.             SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  2905.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2906.             RPCLOSE(OUT$FETP);
  2907.             RESTPFP(PFP$ABORT);
  2908.             END
  2909.  
  2910.           ELSE
  2911.             BEGIN
  2912.             SSMSG$PROC[0] = PROCNAME;
  2913.             MESSAGE(SSMSG[0],SYSUDF1);
  2914.             RPCLOSE(OUT$FETP);
  2915.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  2916.             END
  2917.  
  2918.           END  # CHECK FOR TYPE OF ERROR #
  2919.  
  2920. #
  2921. *     CHECK IF SM ASSIGNED TO SUBFAMILY.
  2922. #
  2923.  
  2924.         SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
  2925.         DO
  2926.           BEGIN  # CHECK EACH SELECTED SM #
  2927.           IF B<SM,1>SEL$SM EQ 0
  2928.           THEN                       # SM NOT SELECTED #
  2929.             BEGIN
  2930.             TEST SM;
  2931.             END
  2932.  
  2933.           P<PREAMBLE> = PRMBADR;
  2934.           TEMP$SM = SM;
  2935.           LN$CNT = MAX$LN + 1;       # INITIALIZE LINE COUNT #
  2936.  
  2937. #
  2938. *     IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM.
  2939. #
  2940.  
  2941.           IF PRM$SCW1[SM] EQ 0
  2942.           THEN                       # SM NOT ASSIGNED TO SUBFAMILY #
  2943.             BEGIN
  2944.             TEST SM;
  2945.             END
  2946.  
  2947. #
  2948. *     PROCESS ALL *FCT* ENTRIES.
  2949. #
  2950.  
  2951.           SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
  2952.           DO
  2953.             BEGIN  # PROCESS AN *FCT* ENTRY #
  2954.  
  2955. #
  2956. *     GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
  2957. #
  2958.  
  2959.             CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG);
  2960.             IF FLAG NQ CMASTAT"NOERR"
  2961.             THEN                     # UNABLE TO GET *FCT* #
  2962.               BEGIN
  2963.               SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  2964.               MESSAGE(SSMSG$BUF[0],SYSUDF1);
  2965.               RPCLOSE(OUT$FETP);
  2966.               RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT #
  2967.               END
  2968.  
  2969.             P<FCT> = FCTADR;
  2970.  
  2971. #
  2972. *     CHECK THE CUBICLE STATUS.  IF IT DOES NOT CONTAIN A
  2973. *     CARTRIDGE GO TO NEXT CUBICLE.
  2974. #
  2975.  
  2976.             IF FCT$CSND[0] EQ "   "
  2977.               OR FCT$CSNI[0] EQ 0
  2978.             THEN                     # NO CARTRIDGE AT THIS LOCATION #
  2979.               BEGIN
  2980.               TEST J;
  2981.               END
  2982.  
  2983. #
  2984. *     WRITE HEADER TO REPORT FILE IF NEW PAGE.
  2985. #
  2986.  
  2987.             IF LN$CNT GQ MAX$LN
  2988.             THEN                     # PAGE EJECT AND PRINT HEADER #
  2989.               BEGIN
  2990.               RPEJECT(OUT$FETP);
  2991.               RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT C - ",5,26,1);
  2992.               RPLINE(OUT$FETP,"DETAILED CARTRIDGE REPORT",31,25,1);
  2993.               RPLINE(OUT$FETP,"SM = ",58,5,1);
  2994.               RPLINE(OUT$FETP,TEMP$SM,63,1,1);
  2995.               RPLINE(OUT$FETP,"SUBFAMILY = ",67,12,1);
  2996.               CHAR$10[0] = XCDD(SUBFAM);
  2997.               RPLINE(OUT$FETP,CHAR$R1[0],79,1,1);
  2998.               RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
  2999.               RPLINE(OUT$FETP,TEMP$FAM,93,7,0);
  3000.               RPSPACE(OUT$FETP,SP"SPACE",1);
  3001.  
  3002. #
  3003. *     PRINT NOTES AND COLUMN HEADINGS.
  3004. #
  3005.  
  3006.               RPLINE(OUT$FETP,"FLAGS:",5,6,1);
  3007.               RPLINE(OUT$FETP,"I = INHIBIT ALLOCATION",15,22,1);
  3008.               RPLINE(OUT$FETP,"M = MISSING",49,12,1);
  3009.               RPLINE(OUT$FETP,"P = EXCESSIVE PARITY ERRORS",81,27,0);
  3010.               RPLINE(OUT$FETP,"E = MAP ERROR",15,13,1);
  3011.               RPLINE(OUT$FETP,"OCL = AVAILABLE LINK COUNT",49,26,1);
  3012.               RPLINE(OUT$FETP,"FCTORD = SFM CATALOG ORDINAL",81,28,0);
  3013.               RPSPACE(OUT$FETP,SP"SPACE",1);
  3014.               RPLINE(OUT$FETP,"------AU------      CARTRIDGE",55,29,0);
  3015.               RPLINE(OUT$FETP," Y   Z    CM  CSN",2,17,1);
  3016.               RPLINE(OUT$FETP,"GROUP    FCTORD   FLAGS",26,23,1);
  3017.               RPLINE(OUT$FETP,"FIRST    FIRST       DIVISION",55,29,1);
  3018.               RPLINE(OUT$FETP,"OCL",88,3,0);
  3019.               RPLINE(OUT$FETP,"SMALL    LARGE        POINT",55,27,0);
  3020.               LN$CNT = 11;
  3021.               END
  3022.  
  3023. #
  3024. *     CHECK FOR FLAGS AND SET THE APPROPRIATE CHARACTERS INTO THE
  3025. *     REPORT FLAG.
  3026. #
  3027.  
  3028.             RPTFLAG = "    ";
  3029.             IF FCT$IAF[0]
  3030.             THEN                     # INHIBIT ALLOCATION FLAG SET #
  3031.               BEGIN
  3032.               C<1,1>RPTFLAG = "I";
  3033.               END
  3034.  
  3035.             IF FCT$LCF[0]
  3036.             THEN                     # CARTRIDGE MISSING #
  3037.               BEGIN
  3038.               C<2,1>RPTFLAG = "M";
  3039.               END
  3040.  
  3041.             IF FCT$EEF[0]
  3042.             THEN                     # EXCESSIVE ERROR FLAG SET #
  3043.               BEGIN
  3044.               C<3,1>RPTFLAG = "P";
  3045.               END
  3046.  
  3047.             IF FCT$SEF[0]
  3048.             THEN                     # SMMAP ERROR FLAG SET #
  3049.               BEGIN
  3050.               C<0,1>RPTFLAG = "E";
  3051.               END
  3052.  
  3053. #
  3054. *     COUNT AVAILABLE OFF CARTRIDGE LINKS.
  3055. #
  3056.  
  3057.             OCL = 0;
  3058.             IF B<0,1>FCT$OCLF[0] EQ 0
  3059.             THEN
  3060.               BEGIN
  3061.               OCL = OCL + 1;
  3062.               END
  3063.  
  3064.             IF B<1,1>FCT$OCLF[0] EQ 0
  3065.             THEN
  3066.               BEGIN
  3067.               OCL = OCL + 1;
  3068.               END
  3069.  
  3070.             IF B<2,1>FCT$OCLF[0] EQ 0
  3071.             THEN
  3072.               BEGIN
  3073.               OCL = OCL + 1;
  3074.               END
  3075.  
  3076. #
  3077. *     CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE REPORT
  3078. *     FILE.
  3079. #
  3080.  
  3081.             CHAR$10[0] = XCDD(FCT$Y[0]);
  3082.             RPLINE(OUT$FETP,CHAR$R2[0],2,2,1);
  3083.  
  3084.             CHAR$10[0] = XCDD(FCT$Z[0]);
  3085.             RPLINE(OUT$FETP,CHAR$R2[0],6,2,1);
  3086.  
  3087.             CHAR$10[0] = FCT$CCOD[0];
  3088.             BZFILL(CHAR,TYPFILL"BFILL",10);
  3089.             RPLINE(OUT$FETP,CHAR$L2[0],12,2,1);
  3090.  
  3091.             CHAR$10[0] = FCT$CSND[0];
  3092.             BZFILL(CHAR,TYPFILL"BFILL",10);
  3093.             RPLINE(OUT$FETP,CHAR$L8[0],14,8,1);
  3094.  
  3095.             GP = J / MAXGRT;
  3096.             CHAR$10[0] = XCDD(GP);
  3097.             RPLINE(OUT$FETP,CHAR$R2[0],27,2,1);
  3098.  
  3099.             CHAR$10[0] = XCDD(J);
  3100.             RPLINE(OUT$FETP,CHAR$R3[0],36,3,1);
  3101.  
  3102.             RPLINE(OUT$FETP,RPTFLAG,44,4,1);
  3103.  
  3104.             CHAR$10[0] = XCDD(FCT$FAUSF[0]);
  3105.             RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
  3106.  
  3107.             CHAR$10[0] = XCDD(FCT$FAULF[0]);
  3108.             RPLINE(OUT$FETP,CHAR$R4[0],64,4,1);
  3109.  
  3110.             CHAR$10[0] = XCDD(FCT$CDP[0]);
  3111.             RPLINE(OUT$FETP,CHAR$R4[0],77,4,1);
  3112.  
  3113.             CHAR$10[0] = XCDD(OCL);
  3114.             RPLINE(OUT$FETP,CHAR$R2[0],88,2,0);
  3115.  
  3116.             LN$CNT = LN$CNT + 1;     # INCREMENT LINE COUNT #
  3117.             END  # PROCESS AN *FCT* ENTRY #
  3118.  
  3119.           END  # CHECK EACH SELECTED SM #
  3120.  
  3121. #
  3122. *     CLOSE THE CATALOG.
  3123. #
  3124.  
  3125.         CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
  3126.         IF FLAG NQ CMASTAT"NOERR"
  3127.         THEN                         # UNABLE TO CLOSE CATALOG #
  3128.           BEGIN
  3129.           SSMSG$PROC[0] = PROCNAME;
  3130.           MESSAGE(SSMSG[0],SYSUDF1);
  3131.           RPCLOSE(OUT$FETP);
  3132.           RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
  3133.           END
  3134.  
  3135.         ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER #
  3136.  
  3137.         END  # PROCESS EACH SUBFAMILY #
  3138.  
  3139.       RETURN;
  3140.  
  3141.       END  # USRPTC #
  3142.  
  3143.     TERM
  3144. PROC USRPTD;
  3145. # TITLE USRPTD - GENERATES OPTIONAL REPORT D.                         #
  3146.  
  3147.       BEGIN  # USRPTD #
  3148.  
  3149. #
  3150. **    USRPTD - GENERATES OPTIONAL REPORT D.
  3151. *
  3152. *     THIS PROC LISTS DETAILED AU STATUS INFORMATION FOR EACH
  3153. *     ENTRY IN THE SFMCATALOG PLUS CARTRIDGE USAGE INFORMATION.
  3154. *
  3155. *     PROC USRPTD.
  3156. *
  3157. *     ENTRY.    (SEL$SB)   = BITS SET FOR THE SELECTED SUBFAMILIES.
  3158. *               (SEL$SM)   = BITS SET FOR THE SELECTED SM-S.
  3159. *               (USARG$FM) = FAMILY NAME.
  3160. *
  3161. *     EXIT.     OPTIONAL REPORT D GENERATED.
  3162. *
  3163. *     MESSAGES. 1)  FAMILY NOT FOUND.
  3164. *               2)  UNABLE TO OPEN CATALOG.
  3165. *               3)  SFMCATALOG PARITY ERROR.
  3166. *               4)  SSUSE ABNORMAL, USRPTD.
  3167. *               5)  CARTRIDGE NOT FOUND.
  3168. *
  3169. *     NOTES.    FOR EACH SELECTED SUBFAMILY, PROC *USRPTD* OPENS THE
  3170. *               SFM CATALOG AND SEARCHES FOR THE CARTRIDGE WITH THE
  3171. *               SELECTED *CSN* AND *CM*.  WHEN THE CARTRIDGE IS FOUND
  3172. *               THE CARTRIDGE LINK FIELD OF THE *FCT* ENTRY IS
  3173. *               PRINTED IN OCTAL FOR EACH AU.  IF THE CARTRIDGE
  3174. *               IS NOT FOUND A MESSAGE IS ISSUED TO THE DAYFILE
  3175. *               AND *SSUSE* ABORTS.
  3176. #
  3177.  
  3178. #
  3179. ****  PROC USRPTD - XREF LIST BEGIN.
  3180. #
  3181.  
  3182.       XREF
  3183.         BEGIN
  3184.         PROC BZFILL;                 # BLANK FILLS CHARACTERS #
  3185.         PROC CCLOSE;                 # CLOSES CATALOG #
  3186.         PROC CGETFCT;                # GETS AN *FCT* ENTRY #
  3187.         PROC COPEN;                  # OPENS CATALOG #
  3188.         PROC CRDAST;                 # READ *AST* #
  3189.         PROC LOFPROC;                # LIST OF FILES PROCESSOR #
  3190.         PROC MESSAGE;                # PRINTS MESSAGE IN DAYFILE #
  3191.         PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
  3192.                                        OR RETURN #
  3193.         PROC RPCLOSE;                # CLOSES THE REPORT FILE #
  3194.         PROC RPEJECT;                # PAGE EJECTS FOR REPORT FILE #
  3195.         PROC RPLINE;                 # WRITES LINE TO REPORT FILE #
  3196.         PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE #
  3197.         PROC SETPFP;                 # SET FAMILY AND USER INDEX #
  3198.         PROC ZFILL;                  # ZERO FILL ARRAY #
  3199.         FUNC XCDD  C(10);            # CONVERTS INTEGER TO DISPLAY #
  3200.         FUNC XCOD  C(10);            # CONVERTS OCTAL TO DISPLAY #
  3201.         PROC XWOD;                   # CONVERT OCTAL TO DISPLAY #
  3202.         END
  3203.  
  3204. #
  3205. ****  PROC USRPTD - XREF LIST END.
  3206. #
  3207.  
  3208.       DEF PROCNAME #"USRPTD."#;      # PROC NAME #
  3209.       DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
  3210. *CALL COMBFAS
  3211. *CALL COMBBZF
  3212. *CALL COMBCMD
  3213. *CALL COMBCMS
  3214. *CALL COMBMCT
  3215. *CALL COMBPFP
  3216. *CALL COMSPFM
  3217. *CALL COMXMSC
  3218. *CALL COMTLAB
  3219. *CALL COMTOUT
  3220. *CALL COMTUSE
  3221. *CALL COMTUSP
  3222.  
  3223.       ITEM ASTADR     I;             # *AST* BUFFER ADDRESS #
  3224.       ITEM CODE       C(2);          # CODE FIELD FOR OUTPUT #
  3225.       ITEM COLUMN     I;             # COLUMN POSITION FOR OUTPUT #
  3226.       ITEM ER$CODE    C(1);          # CODE FIELD FOR OUTPUT #
  3227.       ITEM FCTADR     I;             # *FCT* BUFFER ADDRESS #
  3228.       ITEM FLAG       I;             # ERROR FLAG #
  3229.       ITEM GP         I;             # GROUP #
  3230.       ITEM FOUND      B;             # CSN FOUND FLAG #
  3231.       ITEM I          I;             # LOOP VARIABLE #
  3232.       ITEM J          I;             # LOOP VARIABLE #
  3233.       ITEM LN$CNT     I;             # COUNT OF PRINTED LINES #
  3234.       ITEM N          I;             # LOOP VARIABLE #
  3235.       ITEM NUM        C(10);         # AU NUMBER #
  3236.       ITEM SM         I;             # LOOP VARIABLE #
  3237.       ITEM SUBFAM     I;             # LOOP VARIABLE #
  3238.       ITEM TEMP$FAM   C(7);          # HOLDS FAMILY NAME #
  3239.       ITEM TEMP$SM    C(1);          # TEMPORARY CHARACTER #
  3240.  
  3241.       ARRAY DIS[0:0] P(2);
  3242.         BEGIN
  3243.         ITEM DIS$CLFG   C(01,00,10);  # LINK FIELD IN DISPLAY CODE #
  3244.         END
  3245.  
  3246.                                                CONTROL EJECT;
  3247.  
  3248.       ASTADR = LOC(US$ASTENT[0]);
  3249.       FCTADR = LOC(US$FCTENT[0]);
  3250.       SEL$CSN = USARG$CN[0];
  3251.       FOUND = FALSE;
  3252.  
  3253.       IF USARG$CM[0] EQ 0
  3254.       THEN                           # USE DEFAULT MANUFACTURER #
  3255.         BEGIN
  3256.         SEL$CM = IBMCART;
  3257.         END
  3258.  
  3259.       ELSE                           # USE SPECIFIED MANUFACTURER #
  3260.         BEGIN
  3261.         SEL$CM = USARG$CM[0];
  3262.         END
  3263.  
  3264. #
  3265. *     CHANGE ZERO FILL TO SPACE FILL FOR FAMILY AND CARTRIDGE-ID.
  3266. #
  3267.  
  3268.       TEMP$FAM = USARG$FM[0];
  3269.       BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
  3270.       BZFILL(SEL$CM,TYPFILL"BFILL",2);
  3271.       BZFILL(SEL$CSN,TYPFILL"BFILL",8);
  3272.  
  3273. #
  3274. *     CHECK IF SUBFAMILY SELECTED.
  3275. #
  3276.  
  3277.       SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
  3278.       DO
  3279.         BEGIN  # PROCESS EACH SUBFAMILY #
  3280.         IF B<SUBFAM,1>SEL$SB EQ 0
  3281.         THEN                         # SUBFAMILY NOT SELECTED #
  3282.           BEGIN
  3283.           TEST SUBFAM;
  3284.           END
  3285.  
  3286. #
  3287. *     SET THE FAMILY AND USER INDEX.
  3288. #
  3289.  
  3290.         PFP$WRD0[0] = 0;
  3291.         PFP$FAM[0] = USARG$FM[0];
  3292.         PFP$UI[0] = DEF$UI + SUBFAM;
  3293.         PFP$FG1[0] = TRUE;
  3294.         PFP$FG4[0] = TRUE;
  3295.         SETPFP(PFP[0]);
  3296.         IF PFP$STAT[0] NQ 0
  3297.         THEN                         # FAMILY NOT FOUND #
  3298.           BEGIN
  3299.           SSMSG$LINE[0] = " FAMILY NOT FOUND.";
  3300.           MESSAGE(SSMSG$BUF[0],SYSUDF1);
  3301.           RPCLOSE(OUT$FETP);
  3302.           RESTPFP(PFP$ABORT);
  3303.           END
  3304.  
  3305. #
  3306. *     OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS.
  3307. #
  3308.  
  3309.         CHAR$10 = XCDD(SUBFAM);
  3310.         SFMCAT$LST[0] = CHAR$R1[0];
  3311.         RPLINE(OUT$FETP,CHAR$R3[0],8,3,1);
  3312.         COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
  3313.         IF FLAG EQ CMASTAT"NOERR"
  3314.         THEN
  3315.           BEGIN
  3316.           LOFPROC(OCT$LFN[1]);       # ADD LFN TO LIST OF FILES #
  3317.           END
  3318.  
  3319.         IF FLAG NQ CMASTAT"NOERR"
  3320.         THEN
  3321.           BEGIN  # CHECK FOR TYPE OF ERROR #
  3322.           IF FLAG EQ CMASTAT"INTLK"  ##
  3323.             OR FLAG EQ CMASTAT"ATTERR"
  3324.           THEN
  3325.             BEGIN
  3326.             SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG";
  3327.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  3328.             RPCLOSE(OUT$FETP);
  3329.             RESTPFP(PFP$ABORT);
  3330.             END
  3331.  
  3332.           IF FLAG EQ CMASTAT"CIOERR"
  3333.           THEN
  3334.             BEGIN
  3335.             SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  3336.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  3337.             RPCLOSE(OUT$FETP);
  3338.             RESTPFP(PFP$ABORT);
  3339.             END
  3340.  
  3341.           ELSE
  3342.             BEGIN
  3343.             SSMSG$PROC[0] = PROCNAME;
  3344.             MESSAGE(SSMSG[0],SYSUDF1);
  3345.             RPCLOSE(OUT$FETP);
  3346.             RESTPFP(PFP$ABORT);
  3347.             END
  3348.  
  3349.           END  # CHECK FOR TYPE OF ERROR #
  3350.  
  3351. #
  3352. *     CHECK IF SM ASSIGNED TO SUBFAMILY.
  3353. #
  3354.  
  3355.         SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
  3356.         DO
  3357.           BEGIN  # CHECK EACH SELECTED SM #
  3358.           IF B<SM,1>SEL$SM EQ 0
  3359.           THEN                       # SM NOT SELECTED #
  3360.             BEGIN
  3361.             TEST SM;
  3362.             END
  3363.  
  3364.           P<PREAMBLE> = PRMBADR;
  3365.           TEMP$SM = SM;
  3366.           LN$CNT = MAX$LN + 1;       # INITIALIZE LINE COUNT #
  3367.  
  3368. #
  3369. *     IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM.
  3370. #
  3371.  
  3372.           IF PRM$SCW1[SM] EQ 0
  3373.           THEN                       # SM NOT ASSIGNED TO SUBFAMILY #
  3374.             BEGIN
  3375.             TEST SM;
  3376.             END
  3377.  
  3378. #
  3379. *     READ THE *AST* AND CHECK THE RETURNED ERROR STATUS.
  3380. #
  3381.  
  3382.           CRDAST(USARG$FM[0],SUBFAM,SM,ASTADR,0,FLAG);
  3383.           IF FLAG NQ CMASTAT"NOERR"
  3384.           THEN                       # UNABLE TO GET *AST* #
  3385.             BEGIN
  3386.             SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  3387.             MESSAGE(SSMSG$BUF[0],SYSUDF1);
  3388.             RPCLOSE(OUT$FETP);
  3389.             RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
  3390.             END
  3391.  
  3392.           P<AST> = ASTADR;
  3393.  
  3394. #
  3395. *     PROCESS ALL *FCT* ENTRIES.
  3396. #
  3397.  
  3398.           SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
  3399.           DO
  3400.             BEGIN  # PROCESS AN *FCT* ENTRY #
  3401.  
  3402. #
  3403. *     GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
  3404. #
  3405.  
  3406.             CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG);
  3407.             IF FLAG NQ CMASTAT"NOERR"
  3408.             THEN                     # UNABLE TO GET *FCT* #
  3409.               BEGIN
  3410.               SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
  3411.               MESSAGE(SSMSG$BUF[0],SYSUDF1);
  3412.               RPCLOSE(OUT$FETP);
  3413.               RESTPFP(PFP$ABORT);
  3414.               END
  3415.  
  3416.             P<FCT> = FCTADR;
  3417.  
  3418. #
  3419. *     CHECK THE CSN OF THE CARTRIDGE IN THIS CUBICLE.  IF IT IS
  3420. *     NOT THE SELECTED CSN, GET THE NEXT ENTRY.
  3421. #
  3422.  
  3423.             IF FCT$CSND[0] NQ SEL$CSN
  3424.             THEN
  3425.               BEGIN
  3426.               TEST J;
  3427.               END
  3428.  
  3429. #
  3430. *     IF THE CARTRIDGE MANUFACTURER IS DIFFERENT FROM THE SELECTED
  3431. *     MANUFACTURER, GET THE NEXT ENTRY.
  3432. #
  3433.  
  3434.             IF SEL$CM NQ FCT$CCOD[0]
  3435.             THEN
  3436.               BEGIN
  3437.               TEST J;
  3438.               END
  3439.  
  3440.             FOUND = TRUE;
  3441.  
  3442. #
  3443. *     PROCESS EACH AU.
  3444. #
  3445.  
  3446.             SLOWFOR N = 0 STEP 8 UNTIL INAVOT
  3447.             DO
  3448.               BEGIN  # PROCESS EACH AU #
  3449.  
  3450. #
  3451. *     WRITE HEADER TO REPORT FILE IF NEW PAGE.
  3452. #
  3453.  
  3454.               IF LN$CNT GQ MAX$LN
  3455.               THEN
  3456.                 BEGIN  # PAGE EJECT AND PRINT HEADER #
  3457.                 RPEJECT(OUT$FETP);
  3458.                 RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT D - ",5,26,1);
  3459.                 RPLINE(OUT$FETP,"DETAILED AU STATUS REPORT",31,25,1);
  3460.                 RPLINE(OUT$FETP,"SM = ",59,5,1);
  3461.                 RPLINE(OUT$FETP,TEMP$SM,64,1,1);
  3462.                 CHAR$10[0] = XCOD(SUBFAM);
  3463.                 RPLINE(OUT$FETP,"SUBFAMILY = ",68,12,1);
  3464.                 RPLINE(OUT$FETP,CHAR$R1[0],80,1,1);
  3465.                 RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
  3466.                 RPLINE(OUT$FETP,TEMP$FAM,93,7,0);
  3467.                 RPSPACE(OUT$FETP,SP"SPACE",1);
  3468.                 RPLINE(OUT$FETP,"F = FLAWED AU ",9,14,1);
  3469.                 RPLINE(OUT$FETP,"(DEMARK FAILURE)",23,16,0);
  3470.                 RPLINE(OUT$FETP,"V = START OF VOLUME",9,19,0);
  3471.                 RPLINE(OUT$FETP,"E = ONE OF THE ERROR FLAGS",9,26,1);
  3472.                 RPLINE(OUT$FETP," SET (AU CONFLICT, FROZEN ",35,26,1);
  3473.                 RPLINE(OUT$FETP,"CHAIN, START OF FRAGMENT)",61,25,0);
  3474.                 RPSPACE(OUT$FETP,SP"SPACE",1);
  3475.                 RPLINE(OUT$FETP,"FCTORD     Y     Z",5,18,1);
  3476.                 RPLINE(OUT$FETP,"CM  CSN        GROUP",30,20,0);
  3477.  
  3478.                 CHAR$10[0] = XCDD(J);
  3479.                 RPLINE(OUT$FETP,CHAR$R3[0],5,3,1);
  3480.  
  3481.                 CHAR$10[0] = XCDD(FCT$Y[0]);
  3482.                 RPLINE(OUT$FETP,CHAR$R2[0],15,2,1);
  3483.  
  3484.                 CHAR$10[0] = XCDD(FCT$Z[0]);
  3485.                 RPLINE(OUT$FETP,CHAR$R2[0],21,2,1);
  3486.  
  3487.                 CHAR$10[0] = FCT$CCOD[0];
  3488.                 BZFILL(CHAR,TYPFILL"BFILL",2);
  3489.                 RPLINE(OUT$FETP,CHAR$L2[0],30,2,1);
  3490.  
  3491.                 CHAR$10[0] = FCT$CSND[0];
  3492.                 BZFILL(CHAR,TYPFILL"BFILL",10);
  3493.                 RPLINE(OUT$FETP,CHAR$L8[0],32,8,1);
  3494.  
  3495.                 GP = J / MAXGRT;
  3496.                 CHAR$10[0] = XCDD(GP);
  3497.                 RPLINE(OUT$FETP,CHAR$R2[0],46,2,1);
  3498.  
  3499.                 IF (AST$AUSF[J] + AST$AULF[J] + AST$FLAWS[J]) EQ INAVOT
  3500.                 THEN
  3501.                   BEGIN
  3502.                   RPLINE(OUT$FETP,"*** EMPTY CARTRIDGE ***",55,23,0);
  3503.                   END
  3504.  
  3505.                 ELSE
  3506.                   BEGIN
  3507.                   RPLINE(OUT$FETP," ",55,1,0);
  3508.                   END
  3509.  
  3510.                 RPSPACE(OUT$FETP,SP"SPACE",1);
  3511.                 RPLINE(OUT$FETP,"AU         XXX0",6,15,1);
  3512.                 RPLINE(OUT$FETP,"XXX1           XXX2",32,19,1);
  3513.                 RPLINE(OUT$FETP,"XXX3           XXX4",62,19,1);
  3514.                 RPLINE(OUT$FETP,"XXX5           XXX6",92,19,1);
  3515.                 RPLINE(OUT$FETP,"XXX7",122,4,0);
  3516.                 LN$CNT = 13;
  3517.                 END  # PAGE EJECT AND PRINT HEADER #
  3518.  
  3519.               NUM = XCOD(N);
  3520.               RPLINE(OUT$FETP,C<6,3>NUM,5,3,1);
  3521.               RPLINE(OUT$FETP,"X",8,1,1);
  3522.               COLUMN = 12;
  3523.  
  3524.               SLOWFOR I = N STEP 1 UNTIL N + 7
  3525.               DO
  3526.                 BEGIN  # PRINT EIGHT AU ON A LINE #
  3527.  
  3528. #
  3529. *     DO NOT CONTINUE IF ALL AU-S HAVE BEEN REPORTED.
  3530. #
  3531.  
  3532.                 IF I GR INAVOT
  3533.                 THEN
  3534.                   BEGIN
  3535.                   RPLINE(OUT$FETP," ",135,1,0);  # PRINT LINE #
  3536.                   TEST N;
  3537.                   END
  3538.  
  3539. #
  3540. *     DO NOT REPORT ON AU ZERO.
  3541. #
  3542.  
  3543.                 IF N EQ 0 AND I EQ 0
  3544.                 THEN
  3545.                   BEGIN
  3546.                   COLUMN = COLUMN + 15;
  3547.                   TEST I;
  3548.                   END
  3549.  
  3550.                 ER$CODE = " ";
  3551.                 CODE = "  ";
  3552.                 SETFCTX(I);          # SET *FWD* AND *FPS* VALUES #
  3553.  
  3554. #
  3555. *     CHECK EACH AU FOR FLAGS.
  3556. #
  3557.  
  3558.                 IF FCT$AUCF(FWD,FPS) NQ 0  ##
  3559.                   OR FCT$FRCF(FWD,FPS) NQ 0  ##
  3560.                   OR FCT$SFF(FWD,FPS) NQ 0
  3561.                 THEN                 # ONE OF THE ERROR FLAGS SET #
  3562.                   BEGIN
  3563.                   ER$CODE = "E";
  3564.                   END
  3565.  
  3566.                 IF FCT$FAUF(FWD,FPS) NQ 0
  3567.                 THEN                 # FLAWED AU #
  3568.                   BEGIN
  3569.                   CODE = " F";
  3570.                   END
  3571.  
  3572.                 IF FCT$CAUF(FWD,FPS) EQ 0
  3573.                 THEN                 # START OF VOLUME #
  3574.                   BEGIN
  3575.                   CODE = " V";
  3576.                   END
  3577.  
  3578.                 IF FCT$FAUF(FWD,FPS) NQ 0  ##
  3579.                   AND FCT$CAUF(FWD,FPS) EQ 0
  3580.                 THEN                 # FLAWED AU AND START OF VOLUME #
  3581.                   BEGIN
  3582.                   CODE = "FV";
  3583.                   END
  3584.  
  3585. #
  3586. *     CONVERT THE CARTRIDGE LINK FIELD TO OCTAL AND PRINT IT.
  3587. #
  3588.  
  3589.                 XWOD(FCT$CLFG(FWD,FPS),DIS);
  3590.                 RPLINE(OUT$FETP,CODE,COLUMN,2,1);
  3591.                 RPLINE(OUT$FETP,DIS$CLFG[0],COLUMN + 2,10,1);
  3592.                 RPLINE(OUT$FETP,ER$CODE,COLUMN + 12,1,1);
  3593.                 COLUMN = COLUMN + 15;
  3594.                 END  # PRINT EIGHT AU ON A LINE #
  3595.  
  3596.               LN$CNT = LN$CNT + 1;
  3597.               RPLINE(OUT$FETP," ",135,1,0);  # PRINT OUT LINE #
  3598.               END  # PROCESS EACH AU #
  3599.  
  3600. #
  3601. *     CLOSE THE SFM CATALOG AND RETURN.
  3602. #
  3603.  
  3604.             CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
  3605.             IF FLAG NQ CMASTAT"NOERR"
  3606.             THEN
  3607.               BEGIN
  3608.               SSMSG$PROC[0] = PROCNAME;
  3609.               MESSAGE(SSMSG[0],SYSUDF1);
  3610.               RPCLOSE(OUT$FETP);
  3611.               RESTPFP(PFP$ABORT);
  3612.               END
  3613.  
  3614.             RETURN;
  3615.  
  3616.             END  # PROCESS AN *FCT* ENTRY #
  3617.  
  3618.           END  # CHECK EACH SELECTED SM #
  3619.  
  3620. #
  3621. *     CLOSE THE CATALOG.
  3622. #
  3623.  
  3624.         CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
  3625.         IF FLAG NQ CMASTAT"NOERR"
  3626.         THEN                         # UNABLE TO CLOSE CATALOG #
  3627.           BEGIN
  3628.           SSMSG$PROC[0] = PROCNAME;
  3629.           MESSAGE(SSMSG[0],SYSUDF1);
  3630.           RPCLOSE(OUT$FETP);
  3631.           RESTPFP(PFP$ABORT);
  3632.           END
  3633.  
  3634.         ZFILL(FCTBUFCW,1);           # CLEAR CONTROL BUFFER #
  3635.  
  3636.         END  # PROCESS EACH SUBFAMILY #
  3637.  
  3638. #
  3639. *     IF CSN WAS NOT FOUND ISSUE MESSAGE TO DAYFILE AND ABORT.
  3640. #
  3641.  
  3642.       IF NOT FOUND
  3643.       THEN
  3644.         BEGIN
  3645.         SSMSG$LINE[0] = " CARTRIDGE NOT FOUND.";
  3646.         MESSAGE(SSMSG$BUF[0],SYSUDF1);
  3647.         RPCLOSE(OUT$FETP);
  3648.         RESTPFP(PFP$ABORT);
  3649.         END
  3650.  
  3651.       RETURN;
  3652.  
  3653.       END  # USRPTD #
  3654.  
  3655.     TERM
1)
SUBFAM),(SMID
2)
SUBFAM),(SM
3)
FETP
cdc/nos2.source/opl871/ssuse.txt · Last modified: 2023/08/05 17:24 by Site Administrator