ACPD
          IDENT  ACPD 
          SST 
          ENTRY  ACPD 
          ENTRY  PAP
          ENTRY  RFL= 
          SYSCOM B1 
          TITLE  ACPD - ANALYZE PERFORMANCE DATA. 
*COMMENT  ACPD - ANALYZE PERFORMANCE DATA.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
**        MPAR - MULTIPLE PRECISION ARRAY.
* 
* NAME    MPAR   LEN,PREC,LMP 
* 
*         ENTRY  *NAME*   = NAME OF DATA ITEM.
*                *LEN*    = NUMBER OF ENTRIES OF DATA ITEM. 
*                *PREC*   = PRECISION OF ITEM IN PP WORDS.
*                *LMP*    = POINTER TO LENGTH MULTIPLIER. 
* 
*         EXIT   *NAME*   = ORDINAL OF ITEM IN THE CORRESPONDING TABLE. 
*                *P.NAME* = PRECISION OF THE ITEM.
*                *L.NAME* = LENGTH OF THE ITEM. 
* 
*         NOTE   *MPAR* TABLE FORMAT IS 
*T        24/NAME,3/TP,6/LMP,4/ICM,11/PREC,12/LEN 
* 
*         WHERE 
* 
*         *TP*   TYPE OF BLOCK (HEADER, FAST, MEDIUM, SLOW
*                OR SNAPSHOT LOOP). 
*         *ICM*  INDICATES THAT THE FOLLOWING GROUP OF DATA ELEMENTS
*                (UP TO THE NEXT DEFINITION OF *ICM*) IS EITHER A 
*                SINGLE OR MULTIPLE ELEMENT ENTRY.
* 
*         WARNING - IF ARRAY LENGTH IS NOT EQUAL TO ONE. THE ELEMENT
*         PRECISION MUST NOT BE GREATER THAN TWO. 
  
          PURGMAC MPAR
  
          MACRO  MPAR,NAME,LEN,PREC,LMP 
          NOREF  .IC,.TYPE,BL 
 .1       IFC    EQ,$NAME$$ 
          CON    0
 .1       ELSE
 .2       IFC    EQ,$PREC$$ 
          ERR                PRECISION NOT SPECIFIED
 .2       ENDIF 
          IFNE   LEN,1,1
          ERRNG  2-P.NAME    OFFSET CALCULATION ERROR 
          IFEQ   BL,0,1 
 .IC      SET    0
 NAME     EQU    .IC
 .IC      SET    .IC+1
 P.NAME   EQU    PREC 0 
 L.NAME   EQU    LEN 0
          VFD    24/4L_NAME,3/.TYPE,6/LMP,4/.ICM,11/P.NAME,12/L.NAME
 BL       SET    BL+P.NAME*L.NAME 
 .1       ENDIF 
          ENDM
          SPACE  4,10 
**        DDSC - DATA DESCRIPTION.
* 
* NAME    DDSC   SDL,DTY,WFA,WFP
* 
*         ENTRY  *NAME* = ORDINAL OF ITEM IN THE CORRESPONDING
*                         *MPAR* TABLE. 
*                *SDL*  = SELECTION BIT.
*                *DTY*  = DATA TYPE OF ITEM.
*                *WFA*  = WEIGHT FACTOR INSTRUCTION.
*                *WFP*  = WEIGHT FACTOR POINTER.
* 
*         EXIT   *DDSC* ENTRY CONTAINS A POINTER TO THE DECODED 
*                DATA BUFFER *DBUF*, WHERE THE DATA OF THE ITEM 
*                IS DECODED AND STORED. 
* 
*         NOTE - *DDSC* ENTRY FORMAT IS 
* 
*T        1/S,3/D,3/WI,13/WFP,4/ICM,18/LEN,18/FW
* 
*         WHERE 
* 
*         *S*    IS *SDL*.
*         *D*    IS *DTY*.
*         *WI*   IS *WFA*.
*         *ICM*  SINGLE/MULTIPLE ELEMENT ENTRY INDICATOR. 
*         *LEN*  LENGTH OF THE DATA ELEMENT.
*         *FW*   POINT TO THE DECODED DATA BUFFER WHERE 
*                THE VALUE OF THE DATA ELEMENT IS STORED. 
* 
*         WARNING - THE *MPAR* TABLE HAS TO BE DEFINED BEFORE 
*         *DDSC* TABLE CAN BE DEFINED. THE RELATIVE POSITION
*         OF THE DATA ITEMS IN *DDSC* TABLE MUST BE THE SAME
*         AS IN *MPAR* TABLE. 
  
          PURGMAC DDSC
  
          MACRO  DDSC,NAME,SDL,DTY,WFA,WFP
          NOREF  .L,.FW,L._NAME,P._NAME 
          IFGT   P._NAME,5
 .L       SET    P._NAME/5*L._NAME
          ELSE
 .L       SET    L._NAME
          ENDIF 
          VFD    1/SDL,3/DTY,3/WFA,13/WFP,4/0,18/.L,18/.FW
 .FW      SET    .FW+.L 
          ENDM
          SPACE  4,10 
**        DSPT - DISPLAY TEXT DEFINITION. 
* 
* NAME    DSPT   MSGE,SBTL,WORD,BITA,BITL 
* 
*         ENTRY  *NAME* = ORDINAL OF ITEM IN THE CORRRESPONDING 
*                         *DDSC* TABLE. 
*                *MSGE* = DISPLAY TEXT. 
*                *SBTL* = POINTER TO SUBBLOCK TITLES. 
*                *WORD* = WORD COUNT IN MULTITPLE-WORD ENTRY. 
*                *BITA* = BEGIN BIT POSITION FOR NON-WORD-BOUNDARY
*                         ITEMS.
*                *BITL* = BIT LENGTH. 
* 
*         EXIT   *DSPT* BUILDS *DSPTENT* TABLE AND *DSPTTXT* TABLE. 
*                THE *DSPTTXT* TABLE CONTAINS TEXTS USED IN THE REPORT. 
*                THE *DSPTENT* ENTRY FORMAT IS
* 
*T               9/NAME,6/WORD,6/BITA,6/BITL,9/SBTL,6/LN,18/BC
* 
*                WHERE *LN* IS THE LENGTH IN CHARACTER OF THE TEXT, 
*                AND *BC* IS THE BEGIN CHARACTER POSITION OF THE
*                TEXT IN *DSPTTXT* TABLE. 
  
 M2       MICRO  1,,**
 .BC      SET    0
  
          PURGMAC DSPT
  
          MACRO  DSPT,NAME,MSGE,SBTL,WORD,BITA,BITL 
          NOREF  .EC,.LN,.L,.BC,SBT 
          NOREF  .WC,.CC,.RC,.I 
          IFC    EQ,$SBTL$$ 
 SBT      SET   777B
          ELSE
 SBT      SET   SBTL
          ENDIF 
 M1       MICRO  1,,MSGE
 .EC      SET    .EC+1
 .LN      MICCNT M1 
 M        MICRO  1,,*"M2""M1"*
 .L       MICCNT M
          USE    /DSPTENT/
          VFD    9/NAME,6/WORD,6/BITA,6/BITL,9/SBT,6/.LN,18/.BC 
 .BC      SET    .BC+.LN
          USE 
          USE    /DSPTTXT/
          IFNE   .LN,0
 .WC      SET    .L/10
 .CC      SET    .WC*10 
 .RC      SET    .L-.CC 
 M2       MICRO  .CC+1,.RC,*"M"*
 .I       SET    1
          DUP    .WC
 MSG      MICRO  .I,10,*"M"*
          DATA   10H"MSG" 
 .I       SET    .I+10
          ENDD
          ELSE
          DATA   10H"M2"
          ENDIF 
          USE 
          ENDM
          SPACE  4,10 
**        SMGT - SUBBLOCK REPORT TITLE DEFINITION.
* 
*         SMGT   MSGE,CNT,STC 
* 
*         ENTRY  *MSGE* = SUBBLOCK REPORT TITLE.
*                *CNT*  = NUMBER OF ENTRIES IN THE SUBBLOCK.
*                *STC*  = STARTING NUMBER. IGNORED IF *CNT* IS OMITTED. 
* 
*         EXIT   *SMGT* BUILDS A TABLE OF DISPLAY TEXT, 
*                TEN CHARACTERS, LEFT JUSTIFIED, BLANK FILLED 
*                FOR EACH ENTRY.
  
          PURGMAC SMGT
  
 SMGT     MACRO  MSGE,CNT,STC 
          NOREF  .ST,.SM
 MM       MICRO  1,,MSGE
 .IF      IFC    NE,$CNT$$
 .ST      SET    STC
          DUP    CNT
 .IF1     IFLT   .ST,10B
 MC       OCTMIC .ST,1
 .IF1     ELSE
 MC       OCTMIC .ST,2
 .IF1     ENDIF 
 MG       MICRO  1,,$"MM""MC"$
 .ST      SET    .ST+1
          DATA   10H"MG"
 .SM      SET    .SM+1
          ENDD
 .IF      ELSE
          DATA   10H"MM"
 .SM      SET    .SM+1
 .IF      ENDIF 
          ENDM
          SPACE  4,10 
**        DEF - DEFINE CONSTANT.
* 
*         DEF   NAM#VAL#; 
* 
*         ENTRY  *NAM* = CONSTANT NAME. 
*                *VAL* = CONSTANT VALUE.
* 
*         EXIT   *DEF* DEFINES SYMBOLIC CONSTANTS USED BY BOTH
*                SYMPL AND COMPASS PROGRAMS.
* 
*         WARNING - *DEF* CAN ONLY BE USED TO DEFINE INTEGER CONSTANTS. 
*         NON-INTEGER CONSTANTS HAVE TO BE CONVERTED TO INTEGER BEFORE
*         *DEF* CAN BE USED.
  
          PURGMAC DEF 
  
 DEF     MACRO  VALUE 
          NOREF  .BB
 .NAM     MICRO  1,,#_VALUE 
 .BB      MICCNT .NAM 
 .BB      SET    .BB+2
 .VAL     MICRO  .BB,,;_VALUE 
 .VAL     MICRO  1,,#".VAL" 
 ".NAM" EQU ".VAL"
 DEF      ENDM
          SPACE  4,10 
**        COMMON DECKS. 
  
*CALL     COMCMAC 
*CALL     COMSPRD 
*CALL     COMSCPS 
*CALL     COMSEJT 
*CALL     COMSSSD 
*CALL     COMSSCD 
          LIST   X
*CALL     COMSCPD 
*CALL     COMUCPD 
          LIST   *
          TITLE 
ACPD      SPACE  4,10 
***       ACPD - ANALYZE PERFORMANCE DATA.
* 
*         THIS ENTRY POINT IS NEEDED IN ORDER FOR THE 
*         ABSOLUTE BINARY RECORD NAME TO MATCH WITH THE 
*         DECK NAME *ACPD*. IT CONTAINS ONLY A JUMP 
*         INSTRUCTION TO TRANSFER TO THE MAIN SYMPL 
*         PROGRAM *ACPDM*.
  
  
 ACPD     BSS    0           TRANSFER ADDRESS FROM THE LOADER 
          EQ     =XACPDM     TO SYMPL MAIN PROGRAM
          TITLE  PAP - PROCESS ACPD PARAMETERS. 
*         *PAP* DATA DEFINITIONS. 
          SPACE  4,10 
 DS       DATA   0LSUMMARY   SECONDARY DEFAULT VALUE OF S 
 DN       DATA   0L9999999   SECONDARY DEFAULT VALUE OF N 
  
  
 TARG     BSS    0
 FN       ARG    FN,FN       INPUT FILE 
 L        ARG    L,L         REPORT FILE
 S        ARG    DS,S,400B   SUMMARY FILE 
 LO       ARG    LO,LO       LIST OPTION
 IN       ARG    IN,IN,400B  INTERVAL LENGTH IN MINUTES 
 IC       ARG    IC,IC,400B  INTERVAL RECORD COUNT
 N        ARG    DN,N,400B   NUMBER OF FILES
 BT       ARG    BT,BT       BEGINNING TIME 
 ET       ARG    ET,ET       ENDING TIME
 BD       ARG    BD,BD       BEGINNING DATE 
 ED       ARG    ED,ED       ENDING DATE
          ARG 
  
 ERC      CON    0           ERROR CODE 
 ERF      CON    FATAL       FATAL ERROR
 EFL      CON    0           ERROR NAME 
  
 PAR      BSS    0           PERROR PARAMETER LIST
          VFD    60/ERC 
          VFD    60/ERF 
          VFD    60/EFL 
  
 VARG     BSS    0
          DATA   0LFN 
          DATA   0LL
          DATA   0LS
          DATA   0LLO 
          DATA   0LIN 
          DATA   0LIC 
          DATA   0LN
          DATA   0LBT 
          DATA   0LET 
          DATA   0LBD 
          DATA   0LED 
PAP       EJECT 
**        PAP - PROCESS *ACPD* PARAMETERS.
* 
*         *PAP* VALIDATES *ACPD* PARAMETERS, AND CONVERTS 
*         PARAMETERS IN DISPLAY CODE NUMBER TO BINARY.
  
 PAP      SUBR               ENTRY/EXIT 
          SB1    1
          SA1    ACTR 
          SA4    ARGR 
          SB4    X1          NUMBER OF ARGUMENTS
          SB5    TARG 
          RJ     ARG
          NZ     X1,PAP12    IF ERROR 
          SA5    FN 
          ZR     X5,PAP11    IF NO DATA FILE
          SA5    LO 
          LX5    6
          SX4    X5-1RZ 
          ZR     X4,PAP1     IF *Z* OPTION
          NZ     X5,PAP11    IF INCORRECT OPTION
 PAP1     SA5    N           CONVERT *N* PARAMETER
          SB7    B1+         ASSUME DECIMAL CONVERSION
          RJ     DXB
          NZ     X4,PAP11    IF ERROR 
          ZR     X6,PAP11    IF ZERO VALUE ENTERED
          SA6    A5+         SET *N* VALUE
          SA1    IN 
          SA5    IC 
          ZR     X5,PAP2     IF *IC* NOT SPECIFIED
          ZR     X1,PAP2     IF *IN* NOT SPECIFIED
          SX6    ERM14       * IN AND IC PARAMETER CONFLICT.* 
          EQ     PAP13       PROCESS ERROR
  
 PAP2     NZ     X5,PAP3     IF *IC* SPECIFIED
          SA5    IN 
          SX6    6
          ZR     X5,PAP4     IF *IN* NOT SPECIFIED
 PAP3     RJ     DXB
          NZ     X4,PAP11    IF ARGUMENT ERROR
          ZR     X6,PAP11    IF ARGUMENT ERROR
 PAP4     SA6    A5          SET *IN* OR *IC* VALUE 
  
*         CHECK FOR *BT* AND *ET* PARAMETERS. 
  
          SB2    B1+B1
          MX0    8*6
          SA5    BT-1 
  
 PAP7     SA5    A5+B1
          ZR     X5,PAP8     IF PARAMETER NOT SPECIFIED OR ZERO 
          LX5    2*6
          BX2    -X0*X5 
          SB3    X2-2R24
          GE     B3,PAP11    IF HOUR .GE. 24
          SB3    X2-2R00
          NG     B3,PAP11    IF HOUR .LT. 00
          LX5    2*6
          BX2    -X0*X5 
          SB3    X2-2R60
          GE     B3,PAP11    IF MINUTE .GE. 60
          SB3    X2-2R00
          NG     B3,PAP11    IF MINUTE .LT. 00
          MX4    -6 
          LX5    6
          BX2    -X4*X5 
          SB3    X2-1R6 
          GE     B3,PAP11    IF SECOND .GE. 6X
          SB3    X2-1R0 
          NG     B3,PAP11    IF SECOND .LT. 0X
          LX5    6
          BX2    -X4*X5 
          SB3    X2-1R9 
          LX5    2*6
          GT     B3,PAP11    IF SECOND .GT. X9
          SB3    X2-1R0 
          NG     B3,PAP11    IF SECOND .LT. X0
          LX5    2*6
          BX2    -X0*X5 
          NZ     X2,PAP11    IF TIME TOO LONG 
 PAP8     SB2    B2-B1
          GT     B2,PAP7     IF NOT DONE
  
*         CHECK FOR *BD* AND *ED* PARAMETERS. 
  
          SB2    2
          SA5    BD-1 
  
 PAP9     SA5    A5+B1
          ZR     X5,PAP10    IF PARAMETER NOT SPECIFIED OR ZERO 
          LX5    2*6
          BX2    -X0*X5 
          SB3    X2-2R99
          GT     B3,PAP11    IF YEAR .GT. 99
          SB3    X2-2R70
          PL     B3,PAP9.1   IF YEAR .GE. 70
          SB3    X2-2R33
          GT     B3,PAP11    IF YEAR .GT. 33
          SB3    X2-2R00
          NG     B3,PAP11    IF YEAR .LT. 00
 PAP9.1   LX5    2*6
          BX2    -X0*X5 
          SB3    X2-2R12
          GT     B3,PAP11    IF MONTH .GT. 12 
          SB3    X2-2R01
          NG     B3,PAP11    IF MONTH .LT. 01 
          LX5    2*6
          BX2    -X0*X5 
          SB3    X2-2R31
          GT     B3,PAP11    IF DAY .GT. 31 
          SB3    X2-2R01
          NG     B3,PAP11    IF DAY .LT. 01 
          MX3    -6 
          BX4    -X3*X2 
          SB3    X4-1R9 
          GT     B3,PAP11    IF DATE .GT. X9
          SB3    X4-1R0 
          NG     B3,PAP11    IF DATE .LT. X0
          LX5    2*6
          BX2    -X0*X5 
          NZ     X2,PAP11    IF DATE TOO LONG 
 PAP10    SB2    B2-B1
          GT     B2,PAP9     IF NOT DONE
          EQ     PAPX        RETURN 
  
*         PROCESS ARGUMENT ERROR. 
  
 PAP11    SB2    FN          GET ARGUMENT NAME
          SB2    A5-B2
          SA4    B2+VARG
  
 PAP12    MX0    2*6
          BX6    X0*X4
          SA6    EFL
          SX6    ERM1        * ACPD ARGUMENT ERROR - XX.* 
  
*         PROCESS ERROR.
  
 PAP13    SA6    ERC         SET ERROR CODE 
          SA1    PAR         SET PARAMETER ADDRESS
          RJ     =XPERROR    NO RETURN
          SPACE  4,10 
*         COMMON DECKS
  
*CALL     COMCARG 
*CALL     COMCDXB 
  
          END    ACPD 
*WEOR 
PRGM ACPDM; 
# TITLE ACPDM - ANALYZE PERFORMANCE DATA.  #
  
      BEGIN  # ACPDM #
  
# 
***   ACPDM - ANALYZE PERFORMANCE DATA. 
* 
*     ANALYZE PERFORMANCE DATA COLLECTED BY *CPD*.
* 
*     COMMAND FORMAT. 
* 
*     ACPD(P1,P2,...,PN)
* 
*     WHERE PI IS ANY OF THE FOLLOWING. 
* 
*     OPTION       DEFAULT       DESCRIPTION
* 
*     FN=LFN1      SAMPLE        DATA FILE NAME.
*     L=LFN2       OUTPUT        REPORT FILE NAME.
*     S=LFN3       0             SUMMARY FILE NAME. 
*                                IF NO EQUIVALENCE, *S* IS ASSUMED
*                                TO BE *SUMMARY*. 
*     IN=NNN       6 MINS        INTERVAL LENGTH IN MINUTES.
*                                IF THE IC PARAMETER IS SPECIFIED AND 
*                                IN IS NOT, THE IC VALUE IS USED
*                                INSTEAD OF THE IN PARAMETER DEFAULT
*                                TO SPECIFY THE REPORT INTERVAL.  USE 
*                                OF BOTH THE IN AND IC PARAMETERS 
*                                RESULTS IN AN ERROR. 
*     IC=NNN       0 RECORDS     INTERVAL RECORD COUNT.  SPECIFIES THE
*                                NUMBER OF SAMPLE FILE RECORDS PER
*                                REPORT INTERVAL.  USE OF BOTH THE IN 
*                                AND IC PARAMETERS RESULTS IN AN ERROR. 
*     N=NNN        1 FILE        NUMBER OF FILES TO PROCESS.
*                                IF NO EQUIVALENCE, *ACPD* WILL PROCESS 
*                                UNTIL EOI OF *LFN1* IS REACHED.
*     LO=Z         0             LIST OPTION. IF LO=Z, ELEMENTS 
*                                WITH ZERO VALUES WILL BE PRINTED.
*                                IF LO=0 (DEFAULT), THESE ELEMENTS
*                                WILL NOT BE PRINTED. *Z* IS THE
*                                ONLY VALID OPTION. 
*     BT=HHMMSS    0             BEGINNING TIME. IF *BT* IS OMITTED,
*                                PROCESSING WILL BEGIN AT THE 
*                                CURRENT DATA FILE POSITION. IF *BT*
*                                IS SPECIFIED, PROCESSING WILL
*                                BEGIN AT THE FILE CONTAINING THE 
*                                RECORD WHOSE TIME EQUALS TO *BT*.
*     BD=YYMMDD    0             BEGINNING DATE. IF *BD* IS OMITTED,
*                                *BD* WILL BE ASSUMED THE DATE OF THE 
*                                FILE WHERE THE DATA FILE IS
*                                CURRENTLY POSITIONED.
*     ET=HHMMSS    0             ENDING TIME. *ACPD* WILL TERMINATE 
*                                WHEN THE RECORD WHOSE TIME EQUALS
*                                TO *ET* IS REACHED.
*     ED=YYMMDD    0             ENDING DATE. *ED* AND *ET* FORM THE
*                                ENDING TIME. IF *ED* IS SPECIFIED BUT
*                                *ET* IS OMITTED, THE ENDING TIME IS
*                                ZERO HOUR OF DAY *ED*. IF *ED* IS
*                                OMITTED BUT *ET* IS SPECIFIED, *ED*
*                                IS SET TO THE VALUE OF *BD*. IF BOTH 
*                                *ED* AND *ET* ARE OMITTED, *ACPD* WILL 
*                                TERMINATE IF THE FOLLOWING OCCURS :  
*                                -NUMBER OF FILES SPECIFIED IN THE
*                                 *N* PARAMETER ARE PROCESSED.
*                                -AT EOI OF THE DATA FILE.
* 
*     SUMMARY FILE FORMAT.
* 
*     THE SUMMARY FILE HAS TWO TYPES OF RECORD, THE HEADER BLOCK
*     RECORD AND THE DATA BLOCK RECORD. 
*     THE HEADER BLOCK RECORD IS THE HEADER RECORD OF THE DATA
*     FILE IN THE UNPACKED FORMAT.
*     EACH DATA BLOCK RECORD CONTAINS VALUES OF THE DATA BLOCK
*     ELEMENTS IN ONE REPORT INTERVAL.
*     THE DATA BLOCK RECORD HAS TWO EQUAL LENGTH PARTS. THE 
*     FIRST PART CONTAINS THE AVERAGE VALUES OF THE DATA BLOCK
*     ELEMENTS. THE SECOND PART CONTAINS THE STANDARD DEVIATIONS
*     OF EACH DATA BLOCK ELEMENTS.
*     THE LOOP SAMPLE TIMES AND THE SNAPSHOT ELEMENTS DO NOT
*     HAVE STANDARD DEVIATIONS (0). 
*     THERE IS AN EOR BETWEEN TWO CONSECUTIVE RECORDS.
* 
*     MESSAGES. 
* 
*        -ACPD ARGUMENT ERROR - XX. 
*           ERROR DETECTED IN COMMAND SYNTAX. 
* 
*        -BT/BD NOT FOUND.
*           *BT*/*BD* GREATER THAN THE TIME OF THE LAST DATA RECORD.
* 
*        -CPD/ACPD VERSIONS MISMATCH. 
*           *CPD* AND *ACPD* VERSIONS ARE NOT COMPATIBLE. 
* 
*        -DATA BLOCKS MISSING.
*           EXPECTED DATA BLOCKS FOLLOWING HEADER BLOCK NOT FOUND.
* 
*        -DATA ELEMENT NAME UNDEFINED - XXXX. 
*           DATA ELEMENT XXXX IS NOT DEFINED IN COMMON DECK COMSCPD.
* 
*        -DATA FILE POSITIONED AT *EOI*.
*           DATA FILE IS INITIALLY POSITIONED AT EOI. 
* 
*        -DATA FILE EMPTY.
*           DATA FILE IS EMPTY. 
* 
*        -DATA FILE CONTENT ERROR.
*           DATA FILE GENERATED BY *CPD* IS NOT IN THE EXPECTED 
*           FORMAT. 
* 
*        -DATA FILE NOT AT BEGINNING OF A FILE. 
*           AT THE BEGINNING OF PROCESSING, THE DATA FILE IS
*           POSITIONED EITHER AT THE MIDDLE OF A RECORD, OR 
*           AT THE BEGINNING OF A DATA BLOCK RECORD.
* 
*        -DATA FILE NOT FOUND - XXX.
*           DATA FILE XXX IS NOT LOCAL TO THE JOB AT THE TIME *ACPD*
*           IS RUNNING. 
* 
*        -DATA FILE NOT IN CHRONOLOGICAL ORDER. 
*           DATA FILE IS NOT IN THE INCREASING ORDER OF TIME OF THE 
*           RECORDS.
* 
*        -IN LESS THAN FILE WRITE TIME. 
*           REPORT TIME INTERVAL LESS THAN FILE WRITE TIME
*           (*FW*) OF *CPD*.
* 
*        -IN AND IC PARAMETER CONFLICT. 
*           THE IN AND IC PARAMETERS WERE BOTH SPECIFIED ON THE *ACPD*
*           COMMAND.
* 
*        -N EXCEEDS NUMBER OF FILES.
*           NUMBER OF FILES REQUESTED GREATER THAN NUMBER OF FILES
*           ON THE DATA FILE. 
* 
* 
*     NOTE. 
* 
*     TO BUILD *ACPD*, DO THE FOLLOWING : 
* 
*         - MODIFY(Z)/*EDIT,ACPD
*         - COMPASS(I,S=NOSTEXT)
*         - SYMPL(I)
*         - LDSET(LIB=SRVLIB,PRESET=ZERO) 
*         - LOAD(LGO) 
*         - NOGO(ACPD,ACPD,$RFL=$)
* 
# 
  
# 
****  PRGM ACPDM - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC DATBLK;                 # PROCESS DATA BLOCK # 
        PROC HEADER;                 # PROCESS HEADER BLOCK # 
        PROC INITLZ;                 # INITIALIZE *ACPD* #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC RPCLOSE;                # CLOSE FILES #
        END 
  
# 
****  PRGM ACPDM - XREF LIST END. 
# 
  
      DEF LISTCON    #0#;            #TURN OFF COMMON DECK LISTING #
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM DTDC       B;             # DATA BLOCK DECODED FLAG #
      ITEM HDDC       B;             # HEADER BLOCK DECODED FLAG #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM LSTM       U;             # TIME OF LAST RECORD #
      ITEM EDTM       B;             # ENDING TIME EXPIRED FLAG # 
  
  
  
  
  
# 
*     BEGIN *ACPDM* PROGRAM.
# 
  
      INITLZ(HDDC,DTDC,EDTM);        # INITIALIZE *ACPD* #
  
      SLOWFOR I=1 STEP 1 WHILE (I LQ P$N) AND (NOT EDTM)
      DO
        BEGIN  # PROCESS ONE FILE # 
        HEADER(EDTM,HDDC,LSTM);      # PROCESS HEADER BLOCK # 
        IF (NOT EDTM)                # NOT EOI #
        THEN
          BEGIN 
          DATBLK(EDTM,DTDC,LSTM);    # PROCESS DATA BLOCK # 
          END 
  
        END  # PROCESS ONE FILE # 
  
      IF (P$L NQ NULL)               # REPORT FILE SPECIFIED #
      THEN
        BEGIN  # CLOSE REPORT FILE #
        RPCLOSE(OFFA);
        END 
  
      MESSAGE(" ACPD COMPLETE.",3); 
      END  # ACPDM #
      TERM
PROC ACMSTA((STA),(FWA),(DTY),(BCL),(WFP)); 
# TITLE ACMSTA - PRINT TOTAL STATISTICAL VALUES.  # 
  
      BEGIN  # ACMSTA # 
  
# 
**    ACMSTA - PRINT TOTAL STATISTICAL VALUES.
* 
*     PRINT PERCENTAGE, STANDARD DEVIATION, AND AVERAGE 
*     OF ONE DATA ELEMENT FOR THE ENTIRE *ACPD* RUN.
* 
*     PROC ACMSTA((STA),(FWA),(DTY),(BCL),(WFP))
* 
*     ENTRY      STA = STATISTICAL VALUE TO BE COMPUTED.
*                FWA = ADDRESS OF THE DATA ELEMENT IN TABLE *DDSM*. 
*                DTY = DATA TYPE. 
*                BCL = BEGINNING COLUMN TO PRINT THE VALUE. 
*                WFP = WEIGHT FACTOR. 
* 
*     EXIT       THE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE
*                OF THE DATA ELEMENT FOR THE ENTIRE RUN ARE PRINTED.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM STA        U;             # STATISTIC TO BE COMPUTED # 
      ITEM FWA        U;             # DATA ELEMENT ORDINAL # 
      ITEM DTY        U;             # DATA TYPE #
      ITEM BCL        U;             # BEGINNING COLUMN # 
      ITEM WFP        R;             # WEIGHT FACTOR #
  
# 
****  PROC ACMSTA - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        FUNC SQRT R;                 # SQUARE ROOT FUNCTION # 
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        END 
  
# 
****  PROC ACMSTA - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM VL         R;             # TEMPORARY STORAGE #
  
      ARRAY MAXVAL [0:0] P(1);       # MAXIMUM VALUE #
        BEGIN  # ARRAY MAXVAL # 
        ITEM MAXR       R(00,00,60);  # REAL VALUE #
        ITEM MAXI       I(00,00,60);  # INTEGER VALUE # 
        END  # ARRAY MAXVAL # 
  
      ARRAY MINVAL [0:0] P(1);       # MINIMUM VALUE #
        BEGIN  # ARRAY MINVAL # 
        ITEM MINR       R(00,00,60);  # REAL VALUE #
        ITEM MINI       I(00,00,60);  # INTEGER VALUE # 
        END  # ARRAY MINVAL # 
  
      ARRAY TOTVAL [0:0] P(1);       # TOTAL REPORT VALUE # 
        BEGIN  # ARRAY TOTVAL # 
        ITEM TOTR       R(00,00,60);  # REAL VALUE #
        ITEM TOTI       I(00,00,60);  # INTEGER VALUE # 
        END  # ARRAY TOTVAL # 
  
      SWITCH STAT:STVAL              # STATISTIC #
             PCSS:PCST,              # PERCENTAGE # 
             SDSS:SDST,              # STANDARD DEVIATION # 
             AVSS:AVST;              # AVERAGE #
  
      LABEL PRSTAT;                  # PRINT TOTAL STATISTICS # 
  
  
  
  
# 
*     BEGIN ACMSTA PROC.
# 
  
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
      GOTO STAT[STA]; 
  
# 
*     COMPUTE AND PRINT TOTAL PERCENTAGE. 
# 
  
PCSS:                                # PERCENTAGE # 
      IF (WFP EQ 0) 
      THEN
        BEGIN 
        TOTR[0]=0.0;
        END 
  
      ELSE
        BEGIN 
        TOTR[0]=(DDSM$SM[FWA]/(ACNS*WFP))*100.0;
        END 
  
      MAXR[0]=DDSM$PX[FWA];          # MAXIMUM PERCENTAGE # 
      MINR[0]=DDSM$PN[FWA];          # MINIMUM PERCENTAGE # 
      GOTO PRSTAT;
  
# 
*     COMPUTE AND PRINT TOTAL STANDARD DEVIATION. 
# 
  
SDSS:                                # STANDARD DEVIATION # 
      VL=DDSM$SM[FWA]/ACNS; 
      TOTR[0]=SQRT(DDSM$SQ[FWA]/ACNS - VL*VL);
      MAXR[0]=DDSM$SX[FWA];          # MAXIMUM STANDARD DEVIATION # 
      MINR[0]=DDSM$SN[FWA];          # MINIMUM STANDARD DEVIATION # 
      GOTO PRSTAT;
  
# 
*     COMPUTE AND PRINT TOTAL AVERAGE.
# 
  
AVSS:                                # AVERAGE #
      VL=DDSM$SM[FWA];
      IF (DTY EQ FLPC)               # REAL FORMAT #
      THEN
        BEGIN 
        TOTR[0]=VL/ACNS;
        MAXR[0]=DDSM$AX[FWA];        # MAXIMUM AVERAGE #
        MINR[0]=DDSM$AN[FWA];        # MINIMUM AVERAGE #
        END 
  
      ELSE                           # NOT REAL FORMAT #
        BEGIN 
        TOTI[0]=VL/ACNS;
        MAXI[0]=DDSM$AX[FWA];        # MAXIMUM AVERAGE #
        MINI[0]=DDSM$AN[FWA];        # MINIMUM AVERAGE #
        END 
  
# 
*     PRINT TOTAL STATISTICS. 
# 
  
PRSTAT:                              # PRINT STATISTIC VALUES # 
      WRITEV(TOTVAL[0],DTY,BCL+1,9,NLFC); 
      WRITEV(MAXVAL[0],DTY,BCL+10,10,NLFC); 
      WRITEV(MINVAL[0],DTY,BCL+20,10,LFDC); 
      RETURN; 
      END  # ACMSTA # 
  
      TERM
PROC ADJUST;
# TITLE ADJUST - ADJUST TABLES AND FIELD LENGTH.  # 
  
      BEGIN  # ADJUST # 
  
# 
**    ADJUST - ADJUST TABLES AND FIELD LENGTH.
* 
*     THIS PROC RECOMPUTES THE FIELD LENGTH AND BUFFER ADDRESSES. 
*     IT ALSO COMPUTES THE DECODED BUFFER ADDRESSES OF TABLES 
*     *DDHD* AND *DDDT*.
*     THE MASS STORAGE DEVICE SUBBLOCK TITLE TABLE IS CONSTRUCTED 
*     BASED ON THE EST. 
* 
*     PROC ADJUST 
* 
*     ENTRY      NONE.
* 
*     EXIT       THE NEW DECODED BUFFER LENGTHS OF THE HEADER 
*                BLOCK *DCHL* AND DATA BLOCK *DCDL* ARE COMPUTED. 
*                THE DECODED BUFFER POINTERS OF TABLES *DDHD* AND 
*                *DDDT* ARE COMPUTED. 
*                NEW FIELD LENGTH IS COMPUTED.
*                MASS STORAGE DEVICE SUBBLOCK TITLE TABLE IS
*                CONSTRUCTED. 
# 
  
# 
****  PROC ADJUST - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC MEMORY;                 # REQUEST MEMORY # 
        FUNC XCOD C(10);             # NUMBER TO DISPLAY OCTAL #
        END 
  
# 
****  PROC ADJUST - XREF LIST END.
# 
  
      DEF BLKC       #" "#;          # BLANK #
      DEF CPWC       #5#;            # NUMBER OF CHARACTER PER WORD # 
      DEF MXVC       #1.0E20#;       # MAXIMUM VALUE #
      DEF NA         #"NA"#;         # NO ABORT FLAG #
      DEF RECALL     #1#;            # RECALL FLAG #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
*CALL     COMUEST 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM BL         I;             # BUFFER LENGTH #
      ITEM BLC        I;             # BUFFER LENGTH #
      ITEM CBL        I;             # CURRENT BUFFER LENGTH #
      ITEM CM         C(10)="CM";    # MEMORY ARGUMENT #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM IC         I;             # INCREMENTOR #
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM L          I;             # TEMPORARY STORAGE #
      ITEM LN         I;             # LENGTH # 
      ITEM M          I;             # TEMPORARY STORAGE #
      ITEM MSI        I;             # *MST* ORDINAL #
      ITEM N          I;             # TEMPORARY STORAGE #
      ITEM ORD        C(10);         # *MST* ORDINAL DISPLAY #
      ITEM PR         I;             # PRECISION #
      ITEM RBL        I;             # REQUESTED BUFFER LENGTH #
      ITEM RDCDL      I;             # REQUESTED BUFFER LENGTH #
      ITEM RDCHL      I;             # REQUESTED BUFFER LENGTH #
  
      BASED 
      ARRAY MSD [0:0] P(1);          # MASS STORAGE DEVICE #
        BEGIN  # ARRAY MSD #
        ITEM MSD$WD     I(00,00,60);  # MSD ENTRY # 
        ITEM MSD$EQ     C(00,00,03);  # EQUIPMENT NAME #
        ITEM MSD$OR     C(00,18,07);  # EQUIPMENT ORDINAL # 
        END  # ARRAY MSD #
  
      ARRAY STT [0:0] P(1);          # MEMORY ARGUMENT #
        BEGIN  # ARRAY STT #
        ITEM STT$RFL    U(00,00,30);  # REQUESTED FIELD LENGTH #
        ITEM STT$CMB    U(00,59,01);  # COMPLETION BIT #
        END  # ARRAY STT #
  
  
  
  
  
  
# 
*     BEGIN ADJUST PROC.
# 
  
      P<DCHD>=LOC(DBUF);
  
# 
*     COMPUTE LENGTH OF THE HEADER BLOCK DECODED BUFFER.
# 
  
      BL=0; 
      P<MPAR>=LOC(HDTR);
      P<DDSC>=LOC(DDHD);
  
      J=0;
      SLOWFOR M=0 WHILE (MPAR$WD[J] NQ 0) 
      DO
        BEGIN  # COMPUTE HEADER BLOCK LENGTH AND BUFFER ADDRESS # 
        LN=MPAR$LN[J];
        IF (MPAR$LMP[J] NQ 0) 
        THEN
          BEGIN 
          LN=LN*DCHD$WD[DDSC$FW[MPAR$LMP[J]]];
          END 
  
        PR=MPAR$PR[J];
        IF (PR GR CPWC) 
        THEN
          BEGIN 
          LN=(PR/CPWC)*LN;
          END 
  
        BLC=BL; 
        IC=MPAR$IC[J];
        FASTFOR I=1 STEP 1 UNTIL IC 
        DO
          BEGIN 
          DDSC$FW[J]=BLC; 
          DDSC$LN[J]=LN;
          DDSC$IC[J]=IC;
          BL=BL+LN; 
          BLC=BLC+1;
          J=J+1;
          END 
  
        END  # COMPUTE HEADER BLOCK LENGTH AND BUFFER ADDRESS # 
  
      RDCHL=BL+1;                    # NEW HEADER BLOCK BUFFER LENGTH # 
  
# 
*     COMPUTE THE DATA BLOCK DECODED BUFFER LENGTH. 
# 
  
      BL=0; 
      J=0;
      P<MPAR>=LOC(DATT);
  
      SLOWFOR M=0 WHILE (MPAR$WD[J] NQ 0) 
      DO
        BEGIN  # COMPUTE DATA BLOCK LENGTH AND BUFFER ADDRESS # 
        P<DDSC>=LOC(DDHD);
        LN=MPAR$LN[J];
        IF (MPAR$LMP[J] NQ 0) 
        THEN
          BEGIN 
          LN=LN*DCHD$WD[DDSC$FW[MPAR$LMP[J]]];
          END 
  
        PR=MPAR$PR[J];
        IF (PR GR CPWC) 
        THEN
          BEGIN 
          LN=(PR/CPWC)*LN;
          END 
  
        P<DDSC>=LOC(DDDT);
        BLC=BL; 
        IC=MPAR$IC[J];
        FASTFOR I=1 STEP 1 UNTIL IC 
        DO
          BEGIN 
          DDSC$FW[J]=BLC; 
          DDSC$LN[J]=LN;
          DDSC$IC[J]=IC;
          BL=BL+LN; 
          BLC=BLC+1;
          J=J+1;
          END 
  
        END  # COMPUTE DATA BLOCK LENGTH AND BUFFER ADDRESS # 
  
      RDCDL=BL+1;                    # NEW DATA BLOCK LENGTH #
  
# 
*     COMPUTE NEW FIELD LENGTH. 
# 
  
      RBL=RDCHL+(RDCDL*DCDC*2)+(RDCDL*8);  # NEW LENGTH # 
      CBL=DCHL+(DCDL*DCDC*2)+(DCDL*8);  # OLD LENGTH #
      HGAD=HGAD + (RBL-CBL);         # UPDATE HIGHEST ADDRESS # 
      DCHL=RDCHL; 
      DCDL=RDCDL; 
      IF (HGAD GR CRFL)              # EXCEED FIELD LENGTH #
      THEN
        BEGIN 
        STT$RFL[0]=HGAD;
        MEMORY(CM,STT,RECALL,NA);    # REQUEST MEMORY # 
        CRFL=STT$RFL[0];             # UPDATE CURRENT FIELD LENGTH #
        END 
  
# 
*     INITIALIZE DECODED BUFFER AND TOTAL BUFFER. 
# 
  
      P<DCDT>=LOC(DBUF[DCHL]);
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
      FASTFOR I=0 STEP 1 UNTIL DCDC*DCDL*2 - 1
      DO
        BEGIN 
        DCDT$WD[I]=0; 
        END 
  
      FASTFOR I=0 STEP 1 UNTIL DCDL-1 
      DO
        BEGIN 
        DDSM$IM[I]=0; 
        DDSM$IQ[I]=0; 
        DDSM$AX[I]=0; 
        DDSM$AN[I]=MXVC;
        DDSM$SX[I]=0; 
        DDSM$SN[I]=MXVC;
        DDSM$PX[I]=0; 
        DDSM$PN[I]=MXVC;
        END 
  
# 
*     CONSTRUCT THE MASS STORAGE DEVICE SUBBLOCK TITLE TABLE. 
# 
  
      P<DDSC>=LOC(DDHD);
      P<EST>=LOC(DCHD$WD[DDSC$FW[ESTB]]); 
      P<MSD>=LOC(SMGT[EQTN]); 
      MSI=0;
  
      SLOWFOR J=0 STEP 1 UNTIL DCHD$WD[DDSC$FW[ESTL]] - 1 
      DO
        BEGIN  # SEARCH FOR MASS STORAGE DEVICE IN EST #
        IF (EST$MS[J])               # MASS STORAGE DEVICE #
        THEN
          BEGIN  # BUILD SUBBLOCK TITLE # 
          MSD$EQ[MSI]="EQ ";
          MSD$OR[MSI]=BLKC; 
          ORD=XCOD(J);               # CONVERT TO DISPLAY # 
          N=0;
  
          SLOWFOR I=9 STEP -1 WHILE (C<I,1>ORD NQ BLKC) 
          DO                         # COUNT NUMBER OF DIGITS # 
            BEGIN 
            N=N+1;
            END 
  
          M=I+1;
          L=0;
  
          SLOWFOR I=1 STEP 1 WHILE (I LQ N) 
          DO                         # BUILD MST ORDINAL #
            BEGIN 
            C<L,1>MSD$OR[MSI]=C<M,1>ORD;
            L=L+1;
            M=M+1;
            END 
  
          MSI=MSI+1;
          END  # BUILD SUBBLOCK TITLE # 
  
        END  # SEARCH FOR MASS STORAGE DEVICE IN EST #
  
      MSD$WD[MSI]=0;                 # END OF TABLE # 
  
      RETURN; 
      END  # ADJUST # 
  
      TERM
PROC CHKSPA((SPC),WFT,PRFLG); 
# TITLE CHKSPA - CHECK SPECIAL ACTION.  # 
  
      BEGIN  # CHKSPA # 
  
# 
**    CHKSPA - CHECK SPECIAL ACTION.
* 
*     *CHKSPA* PERFORMS TASKS THAT CANNOT BE TABLE DRIVEN.
*     CURRENTLY THESE ACTIONS INCLUDE COMPUTING AVAILABLE 
*     MEMORY AND BUFFERED I/O CHECKING. 
* 
*     PROC CHKSPA((SPC),WFT,PRFLG)
* 
*     ENTRY      SPC   = SPECIAL ACTION CODE. 
* 
*     EXIT       WFT   = WEIGHT FACTOR. 
*                PRFLG = FLAG INDICATES IF ELEMENT IS TO BE PROCESSED.
# 
  
# 
*     PARAMETER LIST. 
# 
      ITEM SPC        I;             # SPECIAL ACTION CODE #
      ITEM WFT        R;             # WEIGHT FACTOR #
      ITEM PRFLG      B;             # PROCESS FLAG # 
  
# 
****  PROC CHKSPA - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC WRITEV;                 # WRITE DATA VALUE # 
        END 
  
# 
****  PROC CHKSPA - XREF LIST END.
# 
  
      DEF NPCC       #-1.0#;         # NO PERCENTAGE FLAG # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON LISTING #
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM TEM        I;             # TEMPORARY STORAGE #
  
      SWITCH SPAT 
             AVMS,                   # AVAILABLE MEMORY # 
             BIOS,                   # BUFFERED I/O # 
             ;                       # END OF SPAT #
  
  
  
  
  
  
# 
*     BEGIN CHKSPA PROC.
# 
  
      P<DCHD>=LOC(DBUF);
      P<DDSC>=LOC(DDHD);
      PRFLG=FALSE;
  
      GOTO SPAT[SPC]; 
  
AVMS:                                # AVAILABLE MEMORY # 
  
      WFT=DCHD$WD[DDSC$FW[MEMS]]-DCHD$WD[DDSC$FW[CMRS]];
      PRFLG=TRUE; 
      RETURN; 
  
BIOS:                                # BUFFERED I/O PARAMETERS #
      WFT=DCHD$WD[DDSC$FW[TIOB]]; 
      IF (WFT NQ 0)                  # SYSTEM HAS BUFFERED I/O #
      THEN
        BEGIN 
        PRFLG=TRUE; 
        END 
  
      RETURN; 
  
# 
*     END CASE. 
# 
  
      END  # CHKSPA # 
  
      TERM
PROC COMPWF((WFA),(WFP),(POS),WFT,PRFLG); 
# TITLE COMPWF - COMPUTE WEIGHT FACTOR.  #
  
      BEGIN  # COMPWF # 
  
# 
**    COMPWF - COMPUTE WEIGHT FACTOR. 
* 
*     COMPUTE WEIGHT FACTOR FOR PERCENTAGE CALCULATION. 
* 
*     PROC COMPWF((WFA),(WFP),(POS),WFT,PRFLG)
* 
*     ENTRY      WFA = WEIGHT FACTOR INFORMATION. 
*                WFP = WEIGHT FACTOR. 
*                POS = RELATIVE POSITION OF THE WEIGHT FACTOR.
* 
*     EXIT       WFT = COMPUTED WEIGHT FACTOR.
*                      WFT=-1.0 IF PERCENTAGE NOT TO BE PRINTED.
*                PRFLG = PROCESS FLAG.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM WFA        U;             # WEIGHT FACTOR INFORMATION #
      ITEM WFP        U;             # WEIGHT FACTOR #
      ITEM POS        I;             # RELATIVE POSITION OF *WFP* # 
      ITEM WFT        R;             # COMPUTED WEIGHT FACTOR # 
      ITEM PRFLG      B;             # PROCESS FLAG # 
  
# 
****  PROC COMPWF - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC CHKSPA;                 # CHECK SPECIAL ACTION # 
        END 
  
# 
****  PROC COMPWF - XREF LIST END.
# 
  
      DEF NPCC       #-1.0#;         # NO PERCENTAGE FLAG # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
  
      SWITCH WFAT 
             WGFS,                   # WEIGHT FACTOR SPECIFIED #
             NWFS,                   # NO WEIGHT FACTOR # 
             CWFS,                   # CONSTANT WEIGHT FACTOR # 
             SPAS,                   # SPECIAL ACTION # 
             IWFS,                   # INDIRECT WEIGHT FACTOR # 
             ;                       # END OF WFAT #
  
  
  
  
  
# 
*     BEGIN COMPWF PROC.
# 
  
      P<DCHD>=LOC(DBUF);
      P<DDSC>=LOC(DDHD);
      PRFLG=TRUE; 
      GOTO WFAT[WFA]; 
  
WGFS:                                # WEIGHT FACTOR SPECIFIED #
      WFT=DCHD$WD[DDSC$FW[WFP] + POS];
      RETURN; 
  
NWFS:                                # NO WEIGHT FACTOR # 
      WFT=NPCC; 
      RETURN; 
  
CWFS:                                # CONSTANT WEIGHT FACTOR # 
      WFT=WFP;
      IF (WFP EQ 100)                # CONSTANT FACTOR IS 100 # 
      THEN                           # NO PERCENTAGE #
        BEGIN 
        WFT=NPCC; 
        END 
  
      RETURN; 
  
SPAS:                                # SPECIAL ACTION # 
  
      CHKSPA(WFP,WFT,PRFLG);
      RETURN; 
  
IWFS:                                # INDIRECT WEIGHT FACTOR # 
      WFT=0.0;                       # TO BE COMPUTED # 
      RETURN; 
  
# 
*     END CASE. 
# 
  
      END  # COMPWF # 
  
      TERM
PROC DATBLK(EDTM,DTDC,LSTM);
# TITLE DATBLK - PROCESS DATA BLOCK.  # 
  
      BEGIN  # DATBLK # 
  
# 
**    DATBLK - PROCESS DATA BLOCK.
* 
*     DATBLK PROCESSES DATA BLOCKS OF EACH FILE IN THE DATA FILE. 
* 
*     PROC DATBLK(EDTM,DTDC,LSTM) 
* 
*     ENTRY      EDTM = TRUE IF ENDING TIME REACHED,
*                       FALSE IF OTHERWISE. 
*                DTDC = INDICATE IF DATA BLOCK HAS BEEN DECODED.
*                FILE IS POSITIONED AT THE FIRST DATA BLOCK RECORD. 
* 
*     EXIT       TIME = TRUE IF ENDING TIME REACHED.
*                LSTM = TIME OF LAST RECORD.
*                DATA FILE IS POSITIONED AT EITHER *EOI* OR 
*                AT *EOF* OF THE CURRENT FILE. IF TIME IS TRUE, 
*                DATA FILE IS AT THE RECORD CONTAINING THE
*                ENDING TIME. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM EDTM       B;             # ENDING TIME OR EOI FLAG #
      ITEM DTDC       B;             # DECODE DATA BLOCK FLAG # 
      ITEM LSTM       U;             # TIME IF LAST RECORD #
  
# 
****  PROC DATBLK - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC DECODE;                 # DECODE *CIO* INPUT BUFFER DATA # 
        FUNC DTMNUM U;               # CONVERT DATE/TIME TO BINARY #
        PROC PERROR;                 # PROCESS ERROR #
        PROC PUTDAT;                 # PRINT DATA BLOCK ELEMENTS #
        PROC READRC;                 # READ ONE RECORD FROM DATA FILE # 
        PROC WRTSUM;                 # WRITE SUMMARY FILE # 
        END 
  
# 
****  PROC DATBLK - XREF LIST END.
# 
  
      DEF DOTC       #TRUE#;         # FLAG # 
      DEF MXVC       #1.0E10#;       # MAXIMUM VALUE #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM BC         I;             # BEGINNING COLUMN # 
      ITEM FW         I;             # FILE WRITE TIME #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM K          I;             # FOR LOOP CONTROL # 
      ITEM NS         I;             # SAMPLING FREQUENCY # 
      ITEM PT         I;             # ADDRESS OF DECODED DATA BLOCK #
      ITEM STAT       I;             # I/O STATUS # 
      ITEM TM         I;             # TIME OF CURRENT RECORD # 
  
  
  
  
  
# 
*     BEGIN DATBLK PROC.
# 
  
      P<DCHD>=LOC(DBUF);
      P<DCDT>=LOC(DBUF[DCHL]);
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
      TLFG=1;                        # SUBTITLE IS TO BE PRINTED #
  
# 
*     DETERMINE REPORT INTERVAL LENGTH. 
# 
  
      P<DDSC>=LOC(DDHD);
      FW=DCHD$WD[DDSC$FW[DLFW]];     # FILE WRITE TIME #
      IF (P$IN NQ 0)                 # INTERVAL TIME SPECIFIED #
      THEN
        BEGIN 
        NS=(P$IN*60)/FW;             # NUMBER OF RECORDS PER INTERVAL # 
        IF (NS EQ 0)                 # *IN* .LT. *FW* # 
        THEN
          BEGIN 
          PERROR(ERM10,FATAL,NULL);  # IN LESS THAN FILE WRITE TIME # 
          END 
  
        END 
  
      ELSE
        BEGIN 
        NS=P$IC;                     # NUMBER OF RECORDS PER INTERVAL # 
        END 
  
      IF (DTDC)                      # FIRST DATA BLOCK DECODED # 
      THEN
        BEGIN 
        BC=2;                        # COLLECT NEXT SAMPLE #
        ACNS=1; 
        TM=P$BT;
        DTDC=FALSE; 
        END 
  
      ELSE                           # NOT DECODED #
        BEGIN 
        BC=1;                        # COLLECT FIRST SAMPLE # 
        ACNS=0; 
        TM=DTMNUM(DCHD$WD[DDSC$FW[DATE]],DOTC,TRUE)*SHFC; 
        TM=TM + DTMNUM(DCHD$WD[DDSC$FW[TIME]],DOTC,FALSE);
        END 
  
# 
*     PROCESS DATA BLOCKS UNTIL EITHER END OF 
*     CURRENT FILE OR END TIME IS REACHED.
# 
  
      PT=LOC(DCDT); 
      P<DDSC>=LOC(DDDT);
      STAT=EORC;
      TCOL=0;                        # TOTAL NUMBER OF COLUMNS #
  
      SLOWFOR K=1 STEP 1 WHILE (STAT EQ EORC) AND (P$ET GR TM)
      DO
        BEGIN  # COLLECT DATA # 
  
# 
*     COLLECT DATA FOR 10 COLUMNS AND PUT THEM IN THE DECODED 
*     DATA BLOCK BUFFER *DCDT*. *PT* IS THE ADDRESS OF WHERE THE
*     DECODED DATA ARE TO BE STORED IN *DCDT*. FOR EACH COLUMN, THE 
*     NUMBER OF DATA BLOCKS NEEDED TO COLLECT IS DETERMINED BY *NS*.
# 
  
        SLOWFOR I=1 STEP 1 UNTIL DCDC 
        DO
          BEGIN  # PROCESS 10 COLUMNS # 
          SLOWFOR J=BC STEP 1 UNTIL NS
          DO
            BEGIN  # COLLECT DATA FOR THE I-TH COLUMN # 
            IF (IBWA GQ IBNW)        # INPUT BUFFER EXHAUSTED # 
            THEN
              BEGIN  # GET NEXT RECORD #
              READRC(STAT);          # READ NEXT RECORD # 
              IF (STAT NQ EORC)      # EOF OR EOI # 
              THEN
                BEGIN 
                TEST K;              # END OF CURRENT FILE #
                END 
  
              IBWA=0;                # RESET INPUT BUFFER POINTER # 
              END  # GET NEXT RECORD #
  
            DECODE(LOC(DATT),PT);    # DECODE DATA BLOCK #
            ACNS=ACNS+1;             # NUMBER OF DATA BLOCKS DECODED #
            TM=DCDT$WD[(I-1)*DCDL + DDSC$FW[PDTM]];  # GET TIME # 
            IF (TM GQ P$ET)          # CURRENT TIME GREATER THAN #
            THEN                     # ENDING TIME #
              BEGIN 
              TEST K;                # ENDING TIME REACHED #
              END 
  
            END  # COLLECT DATA FOR THE I-TH COLUMN # 
  
          BC=1; 
          TCOL=TCOL+1;
          PT=PT+DCDL;                # NEXT BUFFER ADDRESS #
          END  # PROCESS 10 COLUMNS # 
  
# 
*     DATA OF THE FAST, MEDIUM, SLOW, AND SNAPSHOT LOOPS FOR 10 
*     COLUMNS HAVE BEEN DECODED AND SAVED IN DECODED DATA BLOCK 
*     BUFFER *DCDT*. NOW PRINT THE DATA TO THE REPORT FILE AND
*     THE SUMMARY FILE IF THE SUMMARY FILE IS SPECIFIED.
# 
  
        PUTDAT(NS,DCDC);             # COMPUTE DATA BLOCK ELEMENTS #
        IF (P$S NQ NULL)             # SUMMARY FILE SPECIFIED # 
        THEN
          BEGIN 
          WRTSUM(DCDC);              # WRITE SUMMARY FILE # 
          END 
  
# 
*     REINITIALIZE THE DECODED DATA BLOCK BUFFER FOR NEXT 
*     COLLECTION OF DATA. 
# 
  
        PT=LOC(DCDT); 
        SLOWFOR I=0 STEP 1 UNTIL DCDC*DCDL*2 - 1
        DO
          BEGIN 
          DCDT$WD[I]=0; 
          END 
  
        END  # COLLECT DATA # 
  
# 
*     PROCESS END CASE. 
*     THE NUMBER OF COLUMNS MAY NOT BE 10, AND THE NUMBER OF DATA 
*     BLOCKS COLLECTED FOR THE LAST COLUMN MAY NOT BE *NS*. 
# 
  
      IF (STAT NQ EORC)              # EOF OR EOI # 
      THEN
        BEGIN 
        J=J-1;
        END 
  
# 
*     IF LAST COLUMN DOES NOT HAVE ENOUGH BLOCKS, IGNORE LAST 
*     COLUMN. 
# 
  
      IF (J LS NS)                   # NOT ENOUGH BLOCKS #
      THEN
        BEGIN  # IGNORE LAST INCOMPLETED COLUMN # 
        I=I-1;
        IF (I EQ 0)                  # ONLY ONE COLUMN COLLECTED #
        THEN
          BEGIN 
          I=1;
          NS=J; 
          END 
  
        END  # IGNORE LAST INCOMPLETED COLUMN # 
  
      IF (NS GR 0)                   # LAST COLUMN HAS DATA # 
      THEN
        BEGIN 
        PUTDAT(NS,I);                # PROCESS LAST COLLECTION #
        IF (P$S NQ NULL)             # SUMMARY FILE SPECIFIED # 
        THEN                         # WRITE SUMMARY FILE # 
          BEGIN 
          WRTSUM(I);
          END 
  
        END 
  
      IF (I GR (DCDC-3))             # MORE THAN 7 COLUMNS COLLECTED #
        OR (NS EQ 0)                 # NO BLOCK WAS COLLECTED # 
      THEN                           # PRINT TOTAL ON NEXT PAGE # 
        BEGIN 
        PUTDAT(NS,0);                # PRINT TOTAL #
        END 
  
# 
*     THE CURRENT FILE IS DONE. CHECK IF THERE IS ANOTHER FILE
*     TO REPORT.
# 
  
      IF (P$ET LQ TM)                # ENDING TIME REACHED #
        OR (STAT EQ EOIC)            # EOI ENCOUNTERED ON FILE #
      THEN
        BEGIN 
        EDTM=TRUE;                   # ENDING TIME REACHED OR EOI # 
        END 
  
      ELSE                           # DONE WITH THE CURRENT FILE # 
        BEGIN 
        LSTM=TM;                     # TIME OF LAST RECORD #
        END 
  
      RETURN; 
      END  # DATBLK # 
  
      TERM
PROC DATELM(FLG,MS1,MS2,(WFA),(WFP),(POS),(DTY),(FWA),(NSF)); 
# TITLE DATELM - PROCESS ONE DATA BLOCK ELEMENT.  # 
  
      BEGIN  # DATELM # 
  
# 
**    DATELM - PROCESS ONE DATA BLOCK ELEMENT.
* 
*     COMPUTE AND PRINT ONE DATA BLOCK ELEMENT-S STATISTICAL
*     VALUES (AVERAGE, STANDARD DEVIATION, AND PERCENTAGE). 
* 
*     PROC DATELM(FLG,MS1,MS2,(WFA),(WFP),(POS),(DTY),(FWA),(NSF))
* 
*     ENTRY      FLG = TRUE IF SUB BLOCK TITLE IS TO BE PRINTED.
*                MS1 = SUB BLOCK TITLE. 
*                MS2 = DATA ELEMENT NAME. 
*                WFA = WEIGHT FACTOR INFORMATION. 
*                WFP = WEIGHT FACTOR. 
*                POS = RELATIVE POSITION OF WEIGHT FACTOR.
*                DTY = DATA TYPE. 
*                FWA = ADDRESS OF THE ELEMENT IN TABLE *DCDT*.
*                NSF = NUMBER OF RECORDS PER INTERVAL.
*                NIPP = (COMMON BLOCK *CIOCOMM*) NUMBER OF INTERVALS
*                      PER PAGE.
* 
*     EXIT       THE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE
*                OF THE DATA ELEMENT AT TEN INTERVALS ARE COMPUTED
*                AND PRINTED. 
*                IF THE WEIGHT FACTOR IS THE CONSTANT 1, THE AVERAGE
*                WILL NOT BE PRINTED. 
*                THE PERCENTAGE WILL NOT BE PRINTED IF THE ELEMENT
*                DOES NOT HAVE A WEIGHT FACTOR, OR THE WEIGHT FACTOR
*                IS THE CONSTANT 100. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM FLG        B;             # SUBBLOCK TITLE FLAG #
      ITEM MS1        C(40);         # SUBBLOCK TITLE # 
      ITEM MS2        C(30);         # DATA ELEMENT NAME #
      ITEM WFA        U;             # WEIGHT FACTOR INFORMATION #
      ITEM WFP        U;             # WEIGHT FACTOR #
      ITEM POS        I;             # RELATIVE POSITIN OF *WFP* #
      ITEM DTY        U;             # DATA TYPE #
      ITEM FWA        U;             # ADDRESS OF ENTRY # 
      ITEM NSF        I;             # NUMBER OF SAMPLES PER INTERVAL # 
  
# 
****  PROC DATELM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ACMSTA;                 # COMPUTE TOTAL STATISTICS # 
        PROC COMPWF;                 # COMPUTE WEIGHT FACTOR #
        PROC PRDTEL;                 # PRINT ONE ROW OF DATA ELEMENT #
        FUNC SQRT R;                 # SQUARE ROOT #
        PROC WRITEV;                 # WRITE ONE VALUE #
        END 
  
# 
****  PROC DATELM - XREF LIST END.
# 
  
      DEF AVGC       #"AV"#;         # AVERAGE #
      DEF PCTC       #"PC"#;         # PERCENTAGE # 
      DEF SDVC       #"SD"#;         # STANDARD DEVIATION # 
      DEF ZOPC       #"Z"#;          # *Z* OPTION # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM AV         R;             # AVERAGE VALUE #
      ITEM BCL        I;             # BEGIN COLUMN TO PRINT #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM NIP        R;             # NUMBER OF COLUMNS PER PAGE # 
      ITEM NSR        R;             # NUMBER OF BLOCKS PER COLUMN #
      ITEM PRFLG      B;             # PROCESS FLAG # 
      ITEM SM         R;             # INTERVAL SUM # 
      ITEM SQ         R;             # INTERVAL SUM SQUARED # 
      ITEM SSM        R;             # SUM OF SUBTOTAL #
      ITEM SSQ        R;             # SQUARED SUM OF SUBTOTAL #
      ITEM SWF        R;             # SUM OF WEIGHT FACTOR # 
      ITEM WFT        R;             # WEIGHT FACTOR #
  
      ARRAY TEM [1:11] P(3);         # COMPUTED STATISTIC VALUES #
        BEGIN 
        ITEM TEM$AV     R(00,00,60);  # AVERAGE # 
        ITEM TEM$SD     R(01,00,60);  # STANDARD DEVIATION #
        ITEM TEM$PC     R(02,00,60);  # PERCENTAGE #
        END 
  
  
  
# 
*     BEGIN DATELM PROC.
# 
  
      COMPWF(WFA,WFP,POS,WFT,PRFLG);   # COMPUTE WEIGHT FACTOR #
      IF (NOT PRFLG)                 # NOT TO PROCESS THIS ELEMENT #
      THEN
        BEGIN 
        RETURN; 
        END 
  
      P<DCHD>=LOC(DBUF);
      P<DCDT>=LOC(DBUF[DCHL]);
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
      P<DDSC>=LOC(DDDT);
  
# 
*     CHECK IF ENTIRE LINE IS ZERO. IF SO, DO NOT PRINT THIS LINE.
# 
  
      SM=0; 
      SLOWFOR I=1 STEP 1 UNTIL NIPP 
      DO
        BEGIN 
        SM=SM + DCDT$SM[(I-1)*DCDL + FWA];
        END 
  
      IF (SM EQ 0.0) AND (P$LO NQ ZOPC) AND (NIPP GR (DCDC-3))
      THEN
        BEGIN 
        RETURN; 
        END 
  
      IF (NIPP LQ (DCDC-3))          # PRINT TOTAL ON THIS PAGE # 
      THEN                           # CHECK IF TOTAL IS 0 #
        BEGIN 
        IF (DDSM$IM[FWA] EQ 0) AND (P$LO NQ ZOPC) 
        THEN
          BEGIN 
          RETURN; 
          END 
  
        END 
  
# 
*     CHECK IF SUBTITLE HAS BEEN PRINTED. 
# 
  
      IF (FLG)                       # SUBTITLE NOT PRINTED # 
      THEN                           # PRINT SUBTITLE # 
        BEGIN 
        WRITEV(MS1,CHRC,1,22,LFDC); 
        FLG=FALSE;                   # INDICATE SUBTITLE WAS PRINTED #
        END 
  
      WRITEV(MS2,CHRC,1,22,NLFC);    # WRITE DATA ELEMENT NAME #
  
# 
*     COMPUTE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE 
*     FOR *NIPP* INTERVALS. THE COMPUTED VALUES ARE SAVED 
*     IN ARRAY *TEM*. 
# 
  
      BCL=BCLC;                      # BEGIN COLUMN TO PRINT #
      NSR=NSF;                       # CONVERT TO REAL #
      NIP=NIPP;                      # CONVERT TO REAL #
      SSM=0.0;
      SSQ=0.0;
      SWF=0.0;
  
      IF (NIPP GR 0)
      THEN
        BEGIN  # COMPUTE INTERVAL STATISTICS #
        FASTFOR I=1 STEP 1 UNTIL NIPP 
        DO
          BEGIN  # COMPUTE *AV*, *SD*, *PC* # 
          SM=DCDT$SM[(I-1)*DCDL + FWA]; 
          SSM=SSM+SM; 
          SQ=DCDT$SQ[(I-1)*DCDL+DCDC*DCDL+FWA]; 
          SSQ=SSQ+SQ; 
          AV=SM/NSR;                 # AVERAGE #
          TEM$AV[I]=AV; 
          TEM$SD[I]=SQRT(SQ/NSR - AV*AV);   # STANDARD DEVIATION #
          DCDT$SQ[(I-1)*DCDL+DCDC*DCDL+FWA]=TEM$SD[I];  # SAVE *SD* # 
          DCDT$SM[(I-1)*DCDL+FWA]=TEM$AV[I];  # SAVE *AV* # 
  
          IF (WFA EQ IWFC)           # INDIRECT WEIGHT FACTOR # 
          THEN                       # GET WEIGHT FACTOR #
            BEGIN 
            WFT=DCDT$SM[(I-1)*DCDL + DDSC$FW[WFP]]/NSR; 
            SWF=SWF+WFT;
            END 
  
          IF (WFT LQ 0) 
          THEN
            BEGIN 
            TEM$PC[I]=0.0;
            END 
  
          ELSE
            BEGIN 
            TEM$PC[I]=(AV/WFT)*100.0;  # PERCENTAGE # 
            END 
  
          END  # COMPUTE *AV*, *SD*, *PC* # 
  
# 
*     COMPUTE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE 
*     OF SUBTOTAL. THE PRECEDING INTERVALS ARE CONSIDERED 
*     AS ONE INTERVAL.
# 
  
        IF (TCOL GR (DCDC-3))        # PRINT SUBTOTAL # 
        THEN
          BEGIN  # COMPUTE SUBTOTAL STATISTICS #
          I=NIPP+1; 
          TEM$AV[I]=SSM/(NIP*NSR);   # AVERAGE #
          TEM$SD[I]=SQRT(SSQ/(NIP*NSR)-(TEM$AV[I]*TEM$AV[I]));
          IF (WFA EQ IWFC)           # INDIRECT WEIGHT FACTOR # 
          THEN
            BEGIN 
            WFT=SWF/NIP;             # WEIGHT FACTOR #
            END 
  
          IF (WFT LQ 0) 
          THEN
            BEGIN 
            TEM$PC[I]=0.0;
            END 
  
          ELSE
            BEGIN 
            TEM$PC[I]=(TEM$AV[I]/WFT)*100.0;
            END 
  
          BCL=BCL + I*10; 
          END  # COMPUTE SUBTOTAL STATISTICS #
  
        ELSE                         # NO SUBTOTAL #
          BEGIN 
          BCL=BCL + NIPP*10;
          END 
  
        END  # COMPUTE INTERVAL STATISTICS #
  
# 
*     PRINT VALUES SAVED IN ARRAY *TEM*.
*     AVERAGE VALUES ARE NOT PRINTED IF THE WEIGHT FACTOR 
*     IS 1. 
*     PERCENTAGE VALUES ARE NOT PRINTED IF *WFT* IS LESS THAN 0.
*     THE TOTAL STATISTIC VALUES ARE NOT PRINTED IF THERE ARE 
*     MORE THAN 7 COLUMNS PRINTED ON A PAGE, I.E. IF THE NUMBER 
*     OF INTERVALS PER PAGE *NIPP* IS GREATER THAN 7. 
# 
  
      IF (WFA NQ CWFC) OR (WFP NQ 1)
      THEN
        BEGIN  # PRINT *AV* # 
        WRITEV(AVGC,CHRC,BCLC-2,2,NLFC);
        IF (NIPP GR 0)               # MORE THAN 1 COLUMN # 
        THEN
          BEGIN 
          PRDTEL(LOC(TEM$AV[1]),DTY,LOC(DDSM$AX[FWA])); 
          END 
  
        IF (NIPP LQ (DCDC-3))        # PRINT TOTAL ON SAME PAGE # 
        THEN
          BEGIN 
          ACMSTA(STVAL"AVST",FWA,DTY,BCL,0);  # TOTAL AVERAGE # 
          END 
  
        END  # PRINT *AV* # 
  
      WRITEV(SDVC,CHRC,BCLC-2,2,NLFC);
      IF (NIPP GR 0)                 # MORE THAN 1 COLUMN # 
      THEN
        BEGIN  # PRINT *SD* # 
        PRDTEL(LOC(TEM$SD[1]),FLPC,LOC(DDSM$SX[FWA]));
        END  # PRINT *SD* # 
  
      IF (NIPP LQ (DCDC-3))          # PRINT TOTAL ON SAME PAGE # 
      THEN
        BEGIN 
        ACMSTA(STVAL"SDST",FWA,FLPC,BCL,0);  # STANDARD DEVIATION # 
        END 
  
      IF (WFT GQ 0.0)                # PERCENTAGE TO BE PRINTED # 
      THEN
        BEGIN  # PRINT *PC* # 
        WRITEV(PCTC,CHRC,BCLC-2,2,NLFC);
        IF (NIPP GR 0)               # MORE THAN 1 COLUMN # 
        THEN
          BEGIN 
          PRDTEL(LOC(TEM$PC[1]),FLPC,LOC(DDSM$PX[FWA]));
          END 
  
        IF (WFA EQ IWFC)             # INDIRECT WEIGHT FACTOR # 
        THEN
          BEGIN 
          WFT=DDSM$SM[DDSC$FW[WFP]]/ACNS;  # TOTAL WEIGHT FACTOR #
          END 
  
        IF (NIPP LQ (DCDC-3))        # TOTAL IS PRINTED ON SAME PAGE #
        THEN
          BEGIN 
          ACMSTA(STVAL"PCST",FWA,FLPC,BCL,WFT);  # TOTAL PERCENTAGE # 
          END 
  
        END  # PRINT *PC* # 
  
      RETURN; 
      END  # DATELM # 
  
      TERM
PROC DECODE((DTA),(BFA)); 
# TITLE DECODE - DECODE DATA.  #
  
      BEGIN  # DECODE # 
  
# 
**    DECODE - DECODE DATA. 
* 
*     DECODE DATA IN *CIO* INPUT BUFFER, AND PUT THEM 
*     IN CORRESPONDING DECODED BUFFER.
* 
*     PROC DECODE((DTA),(BFA))
* 
*     ENTRY      DTA = ADDRESS OF DATA DESCRIPTION TABLE
*                      (*DDHD* OR *DDDT*).
*                BFA = ADDRESS OF THE BUFFER WHERE THE DECODED DATA 
*                      ARE TO BE SAVED (*DCHD* OR *DCDT*).
*                IBWA = CURRENT *CIO* INPUT BUFFER ADDRESS. 
* 
*     EXIT       IBWA = ADDRESS OF NEXT *CIO* INPUT BUFFER WORD.
*                DECODED DATA ARE ACCUMULATED IN THE APPROPRIATE
*                BUFFER.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM BFA        I;             # BUFFER ADDRESS # 
      ITEM DTA        I;             # DATA DESCRIPTOR TABLE ADDRESS #
  
# 
****  PROC DECODE - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        FUNC GETVAL I;               # GET VALUE FROM *CIO* BUFFER #
        PROC PERROR;                 # PROCESS ERROR #
        END 
  
# 
**** PROC DECODE - XREF LIST END. 
# 
  
      DEF CNIC       #"CNIL"#;       # FAST LOOP SAMPLE # 
      DEF CPWC       #5#;            # NUMBER OF BYTES #
      DEF CTMC       #"CTML"#;       # MEDIUM LOOP SAMPLE # 
      DEF CTOC       #"CTOL"#;       # SLOW LOOP SAMPLE # 
      DEF HDLC       #0#;            # HEADER LOOP FLAG # 
      DEF PDTC       #"PDTM"#;       # PACKED DATE AND TIME # 
      DEF SNLC       #4#;            # SNAP SHOT LOOP FLAG #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM AV         R;             # AVERAGE VALUE #
      ITEM BA         I;             # BYTE ADDRESS OF *CIO* BUFFER # 
      ITEM BASE       I;             # BEGIN ADDRESS OF REPEAT GROUP #
      ITEM C          I;             # DECODED DATA BUFFER ADDRESS #
      ITEM CQ         I;             # DECODED DATA BUFFER ADDRESS #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM IC         I;             # INCREMENTOR #
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM K          I;             # FOR LOOP CONTROL # 
      ITEM L          I;             # FOR LOOP CONTROL # 
      ITEM LMP        I;             # LENGTH MULTIPLIER #
      ITEM LN         I;             # LENGTH OF ENTRY #
      ITEM M          I;             # FOR LOOP CONTROL # 
      ITEM NM         C(4);          # DATA ELEMENT NAME #
      ITEM OF         I;             # OFFSET # 
      ITEM PR         I;             # NUMBER OF PP WORDS OCCUPIED #
      ITEM TP         U;             # DATA TYPE OF ELEMENT # 
      ITEM VL         I;             # DECODED VALUE #
      ITEM VLR        R;             # DECODED VALUE #
  
      BASED 
      ARRAY BUF [0:0] P(1);          # DECODED BUFFER # 
        BEGIN  # ARRAY BUF #
        ITEM BUF$WD     U(00,00,60);  # DECODED DATA #
        ITEM BUF$SQ     R(00,00,60);  # SUM SQUARE #
        ITEM BUF$SM     R(00,00,60);  # SUM # 
        ITEM BUF$ET     U(00,00,30);  # INTERVAL START TIME # 
        ITEM BUF$BT     U(00,30,30);  # INTERVAL END TIME # 
        END  # ARRAY BUF #
  
      ARRAY SPT [1:3] P(1);          # LOOP SAMPLE TIMES #
        BEGIN  # ARRAY SPT #
        ITEM SPT$WD     I(00,00,60);  # SAMPLE TIME # 
        END  # ARRAY SPT #
  
  
  
  
  
  
# 
*     BEGIN DECODE PROC.
# 
  
      P<DCHD>=LOC(DBUF);
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
      P<MPAR>=DTA;
      P<DDSC>=LOC(DDHD);
      P<BUF>=BFA; 
      BA=IBWA*CPWC; 
  
      IF (MPAR$TP[0] NQ HDLC)        # NOT HEADER BLOCK # 
      THEN
        BEGIN  # GET LOOP SAMPLE TIMES #
        FASTFOR I=1 STEP 1 UNTIL 3
        DO
          BEGIN 
          SPT$WD[I]=GETVAL(BA+SPLA$WD[I],2);
          END 
  
        END  # GET LOOP SAMPLE TIMES #
  
# 
*     FOLLOW TABLE *MPAR* TO EXTRACT DATA FROM *CIO* BUFFER AND PUT 
*     THEM IN THE DECODED DATA BUFFER.
*     THE VALUES STORED IN THE DECODED DATA BUFFER FOR THE DATA 
*     BLOCK ELEMENTS ARE THE CUMULATIVE AVERAGES. THE AVERAGE OF
*     EACH DATA BLOCK ELEMENT IS COMPUTED BY TAKING THE EXTRACTED 
*     VALUE AND DIVIDING IT BY THE RESPECTIVE LOOP-S SAMPLE TIME
*     (*SPT* ARRAY). THE SQUARED AVERAGES ARE ALSO COMPUTED FOR 
*     THE DATA BLOCK ELEMENTS.
# 
  
      C=0;                           # BEGIN ADDRESS TO STORE AVERAGE # 
      OF=DCDL*DCDC;                  # OFFSET # 
      J=0;
  
      SLOWFOR M=0 WHILE (MPAR$WD[J] NQ 0) 
      DO
        BEGIN  # FOLLOW TABLE *MPAR* #
        BASE=J; 
        LMP=1;
        IF (MPAR$LMP[J] NQ NULL)
        THEN
          BEGIN 
          LMP=DCHD$WD[DDSC$FW[MPAR$LMP[J]]];  # REPEAT GROUP LENGTH # 
          END 
  
# 
*     *LMP* IS GREATER THAN 1 IF THE REPEAT GROUP HAS 
*     MULTIPLE ENTRIES. 
# 
  
        FASTFOR K=1 STEP 1 UNTIL LMP
        DO
          BEGIN  # COLLECT REPEAT GROUP VALUES #
          J=BASE; 
          IC=MPAR$IC[J];
  
# 
*     *IC* IS THE SIZE OF THE REPEAT GROUP. 
*     SINGLE ELEMENTS HAVE *IC* EQUAL TO 1. 
# 
  
          FASTFOR L=1 STEP 1 UNTIL IC 
          DO
            BEGIN  # COLLECT ONE ENTRY OF REPEAT GROUP #
            NM=MPAR$NM[J];           # NAME # 
            TP=MPAR$TP[J];           # TYPE # 
            LN=MPAR$LN[J];           # LENGTH # 
            PR=MPAR$PR[J];           # PRECISION #
            IF (PR GR CPWC) 
            THEN
              BEGIN 
              LN=(PR/CPWC)*LN;
              PR=CPWC;
              END 
  
# 
*     *LN* IS GREATER THAN 1 IF THE ELEMENT HAS MULTIPLE
*     ENTRIES.
# 
  
            FASTFOR I=1 STEP 1 UNTIL LN 
            DO
              BEGIN  # COLLECT VALUE OF ONE ENTRY # 
              CQ=C + OF;             # ADDRESS OF SQUARED AVERAGE # 
              VL=GETVAL(BA,PR);      # GET VALUE FROM *CIO* BUFFER #
  
              IF (TP EQ HDLC)        # HEADER BLOCK # 
                OR (TP EQ SNLC)      # SNAPSHOT LOOP #
              THEN
                BEGIN  # COLLECT VALUES # 
  
# 
*     HEADER BLOCK AND SNAPSHOT LOOP DATA ELEMENTS ARE NOT CUMULATIVE 
*     VALUES. 
# 
  
                IF (NM EQ PDTC)      # PACKED DATE AND TIME # 
                THEN
                  BEGIN  # GET TIME # 
                  BUF$ET[CQ]=VL-(VL/SHFC)*SHFC;  # INTERVAL END TIME #
                  IF (DDSM$BT[C] EQ 0) # TOTAL *BT* NOT COLLECTED # 
                  THEN
                    BEGIN 
                    DDSM$BT[C]=VL;  # TOTAL BEGIN TIME #
                    END 
  
                  IF (BUF$BT[CQ] EQ 0) # INTERVAL *BT* NOT COLLECTED #
                  THEN
                    BEGIN 
                    BUF$BT[CQ]=BUF$ET[CQ];  # INTERVAL BEGIN TIME # 
                    END 
  
                  END  # GET TIME # 
  
                BUF$WD[C]=VL; 
                IF (TP EQ SNLC)      # SNAPSHOT LOOP #
                THEN
                  BEGIN 
                  DDSM$IM[C]=VL;
                  END 
  
                END  # COLLECT VALUES # 
  
              ELSE                   # FAST, MEDIUM, SLOW LOOP #
                BEGIN  # DECODE DATA BLOCK VALUES # 
  
# 
*     THE FAST, MEDIUM, AND SLOW LOOP DATA ELEMENTS ARE CUMULATIVE
*     VALUES. THE VALUES SAVED IN THE DECODED BUFFER ARE CUMULATIVE 
*     AVERAGE VALUES. THE AVERAGE VALUE IS COMPUTED BY TAKING THE 
*     VALUE DECODED FROM THE INPUT BUFFER (READ IN FROM THE DATA
*     FILE) AND DEVIDE IT BY THE RESPECTIVE LOOP SAMPLE TIME. 
*     THE AVERAGE SQUARE IS ALSO COMPUTED AND SAVED IN THE DECODED
*     BUFFER FOR EACH DATA BLOCK ELEMENTS.
# 
  
                IF (NM EQ CNIC) 
                  OR (NM EQ CTMC) 
                  OR (NM EQ CTOC)    # LOOP SAMPLE TIMES #
                THEN                 # ACCUMULATE SAMPLE TIMES #
                  BEGIN 
                  BUF$WD[C]=BUF$WD[C] + VL; 
                  DDSM$IM[C]=DDSM$IM[C] + VL; 
                  END 
  
                ELSE
                  BEGIN  # COMPUTE CUMULATIVE *AV* AND SQUARED *AV* # 
                  IF (SPT$WD[TP] NQ 0)  # NUMBER OF SAMPLES .NE. 0 #
                  THEN
                    BEGIN 
                    VLR=VL; 
                    AV=VLR/SPT$WD[TP];
                    BUF$SM[C]=BUF$SM[C] + AV; 
                    BUF$SQ[CQ]=BUF$SQ[CQ] + AV*AV;
                    DDSM$SM[C]=DDSM$SM[C] + AV; 
                    DDSM$SQ[C]=DDSM$SQ[C] + AV*AV;
                    END 
  
                  END  # COMPUTE CUMULATIVE *AV* AND SQUARED *AV* # 
  
                END  # DECODE DATA BLOCK VALUES # 
  
              C=C+1;                 # NEXT DECODED BUFFER ADDRESS #
              BA=BA+PR;              # NEXT *CIO* BUFFER BYTE ADDRESS # 
              END  # COLLECT VALUE OF ONE ENTRY # 
  
            J=J+1;
            END  # COLLECT ONE ENTRY OF REPEAT GROUP #
  
          END  # COLLECT REPEAT GROUP VALUES #
  
        END  # FOLLOW TABLE *MPAR* #
  
# 
*     CHECK IF THERE IS ANY MISSING ELEMENTS. THE VALUE OF
*     *IBWA* HAS TO BE A MULTIPLE OF *IBNW*, FOR THE *CIO* BUFFER 
*     HAS TO CONTAIN A MULTIPLE NUMBER OF DATA BLOCKS OR
*     HEADER BLOCK. 
# 
  
      C=BA/CPWC;
      IBWA=C+1;                      # NEXT *CIO* BUFFER ADDRESS #
      J=BA - (C*CPWC);
      IF (J NQ 0) 
      THEN
        BEGIN 
        C=C+1;
        END 
  
      I=IBNW - (IBNW/C)*C;
      IF (I NQ 0)                    # NOT A MULTIPLE OF *IBNW* # 
      THEN
        BEGIN 
        PERROR(ERM6,FATAL,NULL);     # DATA FILE CONTENT ERROR #
        END 
  
      RETURN; 
      END  # DECODE # 
  
      TERM
PROC DETMXM(MXP,MNP,(MXI),(MNI),(DTY)); 
# TITLE DETMXM - DETERMINE MAXIMUM AND MINIMUM VALUES.  # 
  
      BEGIN  # DETMXM # 
  
# 
**    DETMXM - DETERMINE MAXIMUM AND MINIMUM VALUES.
* 
*     DETERMINE THE MINIMUM AND MAXIMUM VALUES OF ONE 
*     REPORT LINE. THE MAXIMUM VALUE IS INDICATED BY BRACKETS,
*     THE MINIMUM VALUE IS INDICATED BY PARENTHESES.
* 
*     PROC DETMXM(MXP,MNP,(MXI),(MNI),(DTY))
* 
*     ENTRY      MXP = MAXIMUM VALUE ADDRESS. 
*                MNP = MINIMUM VALUE ADDRESS. 
*                MXI = INTERVAL CONTAINING MAXIMUM VALUE. 
*                MNI = INTERVAL CONTAINING MINIMUM VALUE. 
*                DTY = DATA TYPE. 
* 
*     EXIT       MAXIMUM AND MINIMUM VALUES ARE INDICATED BY
*                BRACKETS AND PARENTHESES, RESPECTIVELY.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM MXP        U;             # ADDRESS OF MAXIMUM VALUE # 
      ITEM MNP        U;             # ADDRESS OF MINIMUM VALUE # 
      ITEM MXI        I;             # COLUMN OF MAXIMUM VALUE #
      ITEM MNI        I;             # COLUMN OF MINIMUM VALUE #
      ITEM DTY        U;             # DATA TYPE #
  
# 
****  PROC DETMXM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        FUNC XCDD C(10);             # BINARY TO DISPLAY DECIMAL #
        FUNC XCED C(10);             # BINARY TO *E* FORMAT # 
        FUNC XCOD C(10);             # BINARY TO DISPLAY OCTAL #
        FUNC XCFD C(10);             # BINARY TO DISPLAY REAL # 
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        END 
  
# 
****  PROC DETMXM - XREF LIST END.
# 
  
      DEF BLKC       #" "#;          # BLANK #
      DEF LBKC       #"["#;          # LEFT BRACKET # 
      DEF LPRC       #"("#;          # LEFT PARENTHESIS # 
      DEF MAXF       #1.0E4#;        # MAXIMUM VALUE OF *F* FORMAT #
      DEF RBKC       #"]"#;          # RIGHT BRACKET #
      DEF RPRC       #")"#;          # RIGHT  PARENTHESIS # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM MN         I;             # TEMPORARY VALUE #
      ITEM MNF        R;             # TEMPORARY VALUE #
      ITEM MX         I;             # TEMPORARY VALUE #
      ITEM MXF        R;             # TEMPORARY VALUE #
  
      ARRAY OCV [0:0] P(1);          # OCTAL VALUE #
        BEGIN  # ARRAY OCV #
        ITEM OC$WD      C(00,00,10);  # VALUE # 
        ITEM OC$NP      C(00,06,09);  # NO POSTFIX #
        END  # ARRAY OCV #
  
      ARRAY TM [0:0] P(1);           # TEMPORARY BUFFER # 
        BEGIN  # ARRAY TM # 
        ITEM TM$WD      C(00,00,10);  # DISPLAY CODE MINIMUM VALUE #
        ITEM TM$W1      C(00,00,09);  # VALUE WITH NO POSTFIX # 
        END  # ARRAY TM # 
  
      ARRAY TX [0:0] P(1);           # TEMPORARY BUFFER # 
        BEGIN  # ARRAY TX # 
        ITEM TX$WD      C(00,00,10);  # DISPLAY CODE MAXIMUM VALUE #
        ITEM TX$W1      C(00,00,09);  # VALUE WITH NO POSTFIX # 
        END  # ARRAY TX # 
  
      BASED 
      ARRAY VLMN [0:0] P(1);         # MINIMUM VALUE #
        BEGIN  # ARRAY VLMN # 
        ITEM VLMN$F     R(00,00,60);  # REAL VALUE #
        ITEM VLMN$N     I(00,00,60);  # INTEGER VALUE # 
        END  # ARRAY VLMN # 
  
      BASED 
      ARRAY VLMX [0:0] P(1);         # MAXIMUM VALUE #
        BEGIN  # ARRAY VLMX # 
        ITEM VLMX$F     R(00,00,60);  # REAL VALUE #
        ITEM VLMX$N     I(00,00,60);  # INTEGER VALUE # 
        END  # ARRAY VLMX # 
  
  
  
  
  
# 
*     BEGIN DETMXM PROC.
# 
  
      IF (P$L EQ NULL)               # NO REPORT FILE # 
      THEN
        BEGIN 
        RETURN; 
        END 
  
# 
*     CONVERT MAXIMUM AND MINIMUM VALUES TO DISPLAY CODE. 
# 
  
      P<VLMX>=LOC(MXP); 
      P<VLMN>=LOC(MNP); 
      IF (DTY EQ FLPC)               # REAL VALUE # 
      THEN
        BEGIN 
        IF (VLMX$F[0] GQ MAXF)
        THEN
          BEGIN  # CONVERT TO *E* FORMAT #
          MXF=VLMX$F[0];
          TX$WD[0]=XCED(MXF); 
          END  # CONVERT TO *E* FORMAT #
  
        ELSE
          BEGIN  # CONVERT TO *F* FORMAT #
          MX=VLMX$F[0]*1000.0 + 0.5;
          TX$WD[0]=XCFD(MX);
          END  # CONVERT TO *F* FORMAT #
  
        IF (VLMN$F[0] GQ MAXF)
        THEN
          BEGIN  # CONVERT TO *E* FORMAT #
          MNF=VLMN$F[0];
          TM$WD[0]=XCED(MNF); 
          END  # CONVERT TO *E* FORMAT #
  
        ELSE
          BEGIN  # CONVERT TO *F* FORMAT #
          MN=VLMN$F[0]*1000.0 + 0.5;
          TM$WD[0]=XCFD(MN);
          END  # CONVERT TO *F* FORMAT #
  
        END 
  
      ELSE
        BEGIN 
        IF (DTY EQ INTC)             # INTEGER VALUE #
        THEN
          BEGIN 
          TX$WD[0]=XCDD(VLMX$N[0]); 
          TM$WD[0]=XCDD(VLMN$N[0]); 
          END 
  
        ELSE                         # OCTAL VALUE #
          BEGIN 
          OC$WD[0]=XCOD(VLMX$N[0]); 
          TX$W1[0]=OC$NP[0];
          OC$WD[0]=XCOD(VLMN$N[0]); 
          TM$W1[0]=OC$NP[0];
          END 
  
        END 
  
# 
*     ENCLOSE THE MAXIMUM AND MINIMUM VALUES BY BRACKETS AND
*     PARENTHESES, RESPECTIVELY.
# 
  
      SLOWFOR I=0 STEP 1 WHILE (C<I,1>TX$WD[0] EQ BLKC) DO; 
      MX=MXI*10 + I + 14; 
      WRITEV(LBKC,CHRC,MX,1,NLFC);
      MX=BCLC + MXI*10; 
      WRITEV(RBKC,CHRC,MX,1,NLFC);
  
      SLOWFOR I=0 STEP 1 WHILE (C<I,1>TM$WD[0] EQ BLKC) DO; 
      MN=MNI*10 + I + 14; 
      WRITEV(LPRC,CHRC,MN,1,NLFC);
      MN=BCLC + MNI*10; 
      WRITEV(RPRC,CHRC,MN,1,NLFC);
      RETURN; 
      END  # DETMXM # 
  
      TERM
FUNC DTMNUM((VALUE),(FORM),(PDOS)) I; 
# TITLE DTMNUM - CONVERT DATE/TIME TO NUMBER.  #
  
      BEGIN  # DTMNUM # 
  
# 
**    DTMNUM - CONVERT DATE/TIME TO NUMBER. 
* 
*     CONVERT DISPLAY DATE/TIME TO THE PACKED FORMAT. 
* 
*     FUNC DTMNUM((VALUE),(FORM),(PDOS))
* 
*     ENTRY      VALUE = VALUE TO BE CONVERTED. 
*                FORM = IF TRUE, THE VALUE IS IN FORMAT 
*                       XX.YY.ZZ. 
*                       IF FALSE, THE VALUE IS IN FORMAT
*                       XXYYZZ. 
*                PDOS = IF TRUE, THE PACKED DATE 1970 OFFSET APPLIES. 
*                       IF FALSE, NO OFFSET IS APPLIED. 
* 
*     EXIT       VALUE IS CONVERTED TO PACKED FORMAT, AS IN 
*                THE PACKED DATE AND TIME FORMAT. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM VALUE       C(10);         # VALUE TO BE CONVERTED # 
      ITEM FORM       B;             # FORMAT OF DATE OR TIME # 
      ITEM PDOS       B;             # APPLY PACKED DATE OFFSET # 
  
# 
****  FUNC DTMNUM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC PERROR;                 # PROCESS ERROR #
        END 
  
# 
****  FUNC DTMNUM - XREF LIST END.
# 
  
      DEF ZERC       #"0"#;          # CHARACTER 0 #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM E          I;             # EXPONENTIAL #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM N          I;             # TEMPORARY VARIABLE # 
      ITEM T          U;             # TIME # 
  
      ARRAY TM [0:0] P(1);           # VALUE TO BE CONVERTED #
        BEGIN  # ARRAY TM # 
        ITEM TM$WD      C(00,00,10);  # VALUE # 
        ITEM TM$XX      C(00,00,02);  # XX OF XXYYZZ #
        ITEM TM$YY      C(00,12,02);  # YY OF XXYYZZ #
        ITEM TM$ZZ      C(00,24,02);  # ZZ OF XXYYZZ #
  
        ITEM TM$X1      C(00,06,02);  # XX OF XX.YY.ZZ #
        ITEM TM$D1      C(00,18,01);  # DELIMITER # 
        ITEM TM$Y1      C(00,24,02);  # YY OF XX.YY.ZZ #
        ITEM TM$D2      C(00,36,01);  # DELIMITER # 
        ITEM TM$Z1      C(00,42,02);  # ZZ OF XX.YY.ZZ #
        END  # ARRAY TM # 
  
  
  
  
  
# 
*     BEGIN DTMNUM FUNC.
# 
  
      TM$WD[0]=VALUE; 
  
      IF (FORM)                      # FORMAT XX.YY.ZZ #
      THEN                           # CONVERT TO FORMAT XXYYZZ # 
        BEGIN 
        TM$XX[0]=TM$X1[0];
        TM$YY[0]=TM$Y1[0];
        TM$ZZ[0]=TM$Z1[0];
        END 
  
      IF (TM$WD[0] EQ 0)
      THEN
        BEGIN 
        DTMNUM=0; 
        RETURN; 
        END 
  
# 
*     CONVERT TO THE PACKED FORMAT. 
# 
  
      N=0;
      E=1;
      FASTFOR I=0 STEP 2 UNTIL 5
      DO
        BEGIN 
        T=C<5-I,1>TM$WD[0] - ZERC;
        T=(C<4-I>TM$WD[0] - ZERC)*10 + T; 
        N=N+T*E;
        E=E*64; 
        END 
  
      IF (PDOS)                      # CONVERTING DATE #
      THEN                           # CHECK DATE RANGE # 
        BEGIN 
        IF (N LS Y70C)               # DATE IN 21ST CENTURY # 
        THEN
          BEGIN 
          N=N+Y30C;                  # BIAS 21ST CENTURY DATES #
          END 
        ELSE                         # DATE IN 20TH CENTURY # 
          BEGIN 
          N=N-Y70C;                  # BIAS 20TH CENTURY DATES #
          END 
        END 
  
      DTMNUM=N; 
      RETURN; 
      END  # DTMNUM # 
  
      TERM
PROC GETMSG((ENT),MSG); 
# TITLE GETMSG - GET REPORT MESSAGE.  # 
  
      BEGIN  # GETMSG # 
  
# 
**    GETMSG - GET REPORT MESSAGE.
* 
*     GET MESSAGES FROM COMMON BLOCK *DSPTTXT*. 
* 
*     PROC GETMSG((ENT),MSG)
* 
*     ENTRY      ENT = INDEX OF TABLE *DSPT* ENTRY. 
* 
*     EXIT       MSG = MESSAGE EXTRACTED FROM COMMON BLOCK *DSPTTXT*. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM ENT        I;             # INDEX OF TABLE *DSPT* #
      ITEM MSG        C(50);         # REPORT TITLES #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM BA         I;             # BYTE ADDRESS # 
      ITEM BC         I;             # BEGINNING CHARACTER POSITION # 
      ITEM LN         I;             # MESSAGE LENGTH IN CHARACTER #
  
      BASED 
      ARRAY TXT [0:0] P(1);          # MESSAGE BUFFER # 
        BEGIN  # ARRAY TXT #
        ITEM TXT$MS     C(00,00,60);  # MESSAGE # 
        END  # ARRAY TXT #
  
  
  
  
  
# 
*     BEGIN GETMSG PROC.
# 
  
      LN=DSPT$LN[ENT];               # NUMBER OF CHARACTERS # 
      BC=DSPT$BC[ENT];               # BEGINNING CHARACTER POSITION # 
      BA=BC - (BC/10)*10; 
      P<TXT>=LOC(DSTX$TX[BC/10]); 
      MSG=C<BA,LN>TXT$MS[0];
      RETURN; 
      END  # GETMSG # 
  
      TERM
FUNC GETVAL((BA),(PR)) I; 
# TITLE GETVAL - GET VALUE FROM *CIO* BUFFER.  #
  
      BEGIN  # GETVAL # 
  
# 
**    GETVAL - GET VALUE FROM *CIO* BUFFER. 
* 
*     EXTRACT VALUES FROM THE *CIO* BUFFER OF THE DATA FILE.
* 
*     FUNC GETVAL((BA),(PR)) I
* 
*     ENTRY      BA = BYTE ADDRESS OF THE VALUE TO BE EXTRACTED.
*                PR = NUMBER OF BYTES TO BE EXTRACTED.
* 
*     EXIT       THE VALUE IS EXTRACTED FROM BUFFER *WSAI*. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM BA         I;             # BYTE ADDRESS # 
      ITEM PR         I;             # PRECISION #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM BC         I;             # BYTE ADDRESS # 
      ITEM T          I;             # TEMPORARY VALUE #
      ITEM WA         I;             # *CIO* BUFFER WORD ADDRESS #
  
      BASED 
      ARRAY WSA [0:0] P(1);          # WORKING BUFFER # 
        BEGIN  # ARRAY WSA #
        ITEM WSA$C      C(00,00,20);  # BUFFER ENTRY #
        END  # ARRAY WSA #
  
  
  
  
  
# 
*     BEGIN GETVAL FUNC.
# 
  
      WA=BA/5;                       # ADDRESS TO EXTRACT THE VALUE # 
      P<WSA>=LOC(WSAI$WD[WA]);
      T=BA*2;                        # NUMBER OF CHARACTERS # 
      BC=T - (T/10)*10;              # BEGIN CHARACTER POSITION # 
      GETVAL=C<BC,PR*2>WSA$C[0];
      RETURN; 
      END  # GETVAL # 
  
      TERM
PROC HDRELM((ENP),(FCL),(LCL)); 
# TITLE HDRELM - PRINT HEADER BLOCK ELEMENT.  # 
  
      BEGIN  # HDRELM # 
  
# 
**    HDRELM - PRINT HEADER BLOCK ELEMENT.
* 
*     PRINT ONE ELEMENT OF HEADER BLOCK.
* 
*     PROC HDRELM((ENP),(FCL),(LCL))
* 
*     ENTRY      ENP = INDEX OF THE *DSPT* ENTRY POINTING TO
*                      THE HEADER BLOCK ELEMENT BEING PROCESSED.
*                FCL = BEGINNING COLUMN TO PRINT THE HEADER BLOCK 
*                      ELEMENT NAME.
*                LCL = BEGINNING COLUMN TO PRINT THE HEADER BLOCK 
*                      ELEMENT VALUE. 
* 
*     EXIT       THE HEADER BLOCK ELEMENT IS PRINTED TO THE REPORT
*                FILE.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM ENP        I;             # INDEX OF DSPT ENTRY #
      ITEM FCL        I;             # BEGIN COLUMN TO PRINT NAME # 
      ITEM LCL        I;             # BEGIN COLUMN TO PRINT VALUE #
  
# 
****  PROC HDRELM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC GETMSG;                 # GET TITLE FROM TABLE *DSPTTXT* # 
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        END 
  
# 
****  PROC HDRELM - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM BL         I;             # BIT LENGTH # 
      ITEM BT         I;             # BIT POSITION # 
      ITEM D          I;             # DATA TYPE #
      ITEM J          I;             # POINTER TO *DDHD* TABLE #
      ITEM L          I;             # TITLE LENGTH IN CHARACTERS # 
      ITEM MSG        C(50);         # TEMPORARY BUFFER # 
      ITEM T          I;             # POINTER TO *DCHD* TABLE #
      ITEM VALUE      I;             # TEMPORARY VALUE #
      ITEM WC         I;             # WORD COUNT # 
  
  
  
  
  
# 
*     BEGIN HDRELM PROC.
# 
  
      P<DCHD>=LOC(DBUF);
      P<DDSC>=LOC(DDHD);
      J=DSPT$PT[ENP];                # INDEX OF TABLE *DDSC* #
      L=DSPT$LN[ENP]; 
      T=DDSC$FW[J];                  # INDEX OF TABLE *DCHD* #
      D=DDSC$TY[J];                  # DATA TYPE #
      GETMSG(ENP,MSG);
      WRITEV(MSG,CHRC,FCL,L,NLFC);
      BL=DSPT$BL[ENP];               # GET BIT LENGTH # 
      WC=DSPT$WC[ENP];               # WORD COUNT # 
      IF (BL EQ 0)                   # ACCESS FULL WORD # 
      THEN
        BEGIN 
        VALUE=DCHD$WD[T+WC];
        END 
  
      ELSE                           # ACCESS PARTIAL WORD #
        BEGIN 
        BT=DSPT$BT[ENP];
        VALUE=B<BT,BL>DCHD$WD[T+WC];
        END 
  
      WRITEV(VALUE,D,LCL,10,LFDC);
      RETURN; 
      END  # HDRELM # 
      TERM
PROC HEADER(TMED,HDDC,(LSTM));
# TITLE HEADER - PROCESS HEADER BLOCK.  # 
  
      BEGIN  # HEADER # 
  
# 
**    HEADER - PROCESS HEADER BLOCK.
* 
*     *HEADER* BUILDS THE REPORT TITLE AND PROCESSES THE HEADER BLOCK 
*     OF EACH FILE IN THE DATA FILE.
* 
*     PROC HEADER(TMED,HDDC,(LSTM)) 
* 
*     ENTRY      HDDC = TRUE IF HEADER BLOCK HAS BEEN DECODED.
*                LSTM = TIME OF LAST RECORD.
* 
*     EXIT       TMED = TRUE IF *N* PARAMETER EXCEEDS NUMBER OF FILES.
*                HDDC = FALSE 
*                ELEMENTS IN HEADER BLOCK ARE PRINTED TO THE
*                REPORT FILE. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM TMED       B;             # EOI FLAG # 
      ITEM HDDC       B;             # DECODE HEADER BLOCK FLAG # 
      ITEM LSTM       U;             # ENDING TIME OF PREVIOUS FILE # 
  
# 
****  PROC HEADER - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ADJUST;                 # ADJUST TABLES AND FIELD LENGTH # 
        PROC BZFILL;                 # BLANK/ZERO FILL ITEM # 
        PROC DECODE;                 # DECODE *CIO* INPUT BUFFER DATA # 
        FUNC DTMNUM U;               # CONVERT DATE/TIME TO BINARY #
        PROC PERROR;                 # PROCESS ERROR #
        PROC PUTEST;                 # PRINT EST #
        PROC PUTHDR;                 # PRINT HEADER ELEMENTS #
        PROC PUTSCI;                 # PRINT JOB CONTROL BLOCK #
        PROC READRC;                 # READ AND SKIP #
        PROC RPHEAD;                 # PRINT *ACPD* TITLE # 
        PROC WRITER;                 # *CIO* WRITER # 
        PROC WRITEW;                 # *CIO* WRITEW # 
        END 
  
# 
****  PROC HEADER - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
*CALL     COMABZF 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM D          I;             # TEMPORARY VARIABLE # 
      ITEM L          I;             # TEMPORARY VARIABLE # 
      ITEM STAT       I;             # I/O STATUS # 
      ITEM T          I;             # TEMPORARY VARIABLE # 
  
      BASED 
      ARRAY HEAD [0:0] P(1);         # HEADER SYSTEM DESIGNATOR # 
        BEGIN  # ARRAY HEAD # 
        ITEM HEAD$SD    C(00,00,70);  # SYSTEM DESIGNATOR # 
        END  # ARRAY HEAD # 
  
      ARRAY TEXT [0:0] S(10);        # HEADER TEXT #
        BEGIN  # ARRAY TEXT # 
        ITEM TXT$H1     C(00,00,16);  # *ACPD* VERSION #
        ITEM TXT$VR     C(01,00,10);  # VERSION NUMBER #
        ITEM TXT$H2     C(02,00,10)=["          "];  # BLANK FILL # 
        ITEM TXT$SD     C(03,00,70);  # SYSTEM DESIGNATOR # 
        END  # ARRAY TEXT # 
  
  
  
  
  
# 
*     BEGIN HEADER PROC.
# 
  
      P<MPAR>=LOC(HDTR);
      P<DDSC>=LOC(DDHD);
      P<DCHD>=LOC(DBUF);
  
# 
*     *HDDC* IS NOT TRUE IF *HEADER* IS CALLED TO PROCESS THE NEXT
*     DATA FILE. *HDDC* IS TRUE IF THE FIRST FILE IS BEING PROCESSED. 
*     IF THE LATER IS TRUE, ALL THE ERROR CHECKING HAS BEEN DONE BY 
*     *INITLZ*. 
# 
  
      IF (NOT HDDC)                  # HEADER BLOCK NOT DECODED # 
      THEN
        BEGIN  # READ HEADER BLOCK OF NEXT FILE # 
        READRC(STAT);                # READ HEADER BLOCK #
        IF (STAT NQ EORC)            # EOF OR EOI ENCOUNTERED # 
        THEN
          BEGIN 
          IF (IBNW GR 0)             # INPUT BUFFER NOT EMPTY # 
          THEN
            BEGIN 
            PERROR(ERM4,FATAL,NULL);   # DATA BLOCKS MISSING #
            END 
  
          IF (P$N LS 9999999)        # EQUIVALENCED *N* PARAMETER # 
          THEN
            BEGIN 
            PERROR(ERM9,INFOM,NULL);   # *N* EXCEEDS NUMBER OF FILES #
            END 
  
          TMED=TRUE;
          RETURN; 
          END 
  
        IF (P$VERS NQ WSAI$VS[0])    # *CPD* AND *ACPD* INCOMPATBLE # 
        THEN
          BEGIN 
          PERROR(ERM13,FATAL,NULL);  # CPD/ACPD VERSIONS MISMATCH # 
          END 
  
        IBWA=0; 
        DECODE(LOC(HDTR),LOC(DCHD));  # DECODE HEADER BLOCK # 
        ADJUST;                      # ADJUST TABLES AND FIELD LENGTH # 
  
# 
*     CHECK IF FILES IN CHRONOLOGICAL ORDER.
# 
  
        T=DTMNUM(DCHD$WD[DDSC$FW[TIME]],TRUE,FALSE);
        D=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC;
        IF (LSTM GR (D+T))           # DATA FILE NOT IN ORDER # 
        THEN
          BEGIN 
          PERROR(ERM8,FATAL,NULL);
          END 
  
        END  # READ HEADER BLOCK OF NEXT FILE # 
  
      ELSE                           # HEADER BLOCK HAS BEEN DECODED #
        BEGIN 
        HDDC=FALSE; 
        END 
  
# 
*     BUILD THE REPORT TITLE. 
# 
  
      T=DDSC$FW[CPDV];               # *ACPD* VERSION POINTER # 
      TXT$VR[0]=DCHD$CW[T]; 
      TXT$H1[0]=" A C P D - VER  "; 
  
      T=DDSC$FW[SYSV];               # SYSTEM DESIGNATOR POINTER #
      P<HEAD>=LOC(DCHD$CW[T]);
      T=MPAR$PR[SYSV]*2;
      BZFILL(HEAD,TYPFILL"BFILL",T);
      TXT$SD[0]=HEAD$SD[0]; 
  
      IF (P$L NQ NULL)               # REPORT FILE SPECIFIED #
      THEN
        BEGIN 
        L=30 + T;                    # LENGTH OF HEADER TEXT #
        RPHEAD(OFFA,TEXT,2,L);       # SET UP *ACPD* TITLE #
        PUTHDR;                      # PRINT HEADER BLOCK ELEMENTS #
        PUTEST;                      # PRINT EST #
        PUTSCI;                      # PRINT JOB CONTROL BLOCK #
        END 
  
      IF (P$S NQ NULL)               # SUMMARY FILE SPECIFIED # 
      THEN                           # WRITE SUMMARY FILE # 
        BEGIN 
        WRITEW(FETS,DCHD,DCHL,0); 
        WRITER(FETS,1); 
        END 
  
      RETURN; 
      END  # HEADER # 
  
      TERM
PROC INITLZ(HDDC,DTDC,EDTM);
# TITLE INITLZ - INITIALIZE PARAMETERS AND OPEN FILES.  # 
  
      BEGIN  # INITLZ # 
  
# 
**    INITLZ - INITIALIZE PARAMETERS AND OPEN FILES.
* 
*     PROCESS *ACPD* COMMAND PARAMETERS, INITIALIZE *ACPD*, 
*     AND OPEN FILES. 
* 
*     PROC INITLZ(HDDC,DTDC,EDTM) 
* 
*     ENTRY      NONE.
* 
*     EXIT       HDDC = INDICATE IF HEADER BLOCK HAS BEEN DECODED.
*                DTDC = INDICATE IF DATA BLOCK HAS BEEN DECODED.
*                TIME = TRUE IF BEGINNING TIME GREATER THAN 
*                       ENDING TIME.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM HDDC       B;             # DECODED HEADER BLOCK FLAG #
      ITEM DTDC       B;             # DECODED DATA BLOCK FLAG #
      ITEM EDTM       B;             # ENDING TIME FLAG # 
  
# 
****  PROC INITLZ - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ADJUST;                 # ADJUST TABLES AND FIELD LENGTH # 
        PROC DECODE;                 # DECODE *CIO* INPUT BUFFER DATA # 
        FUNC DTMNUM I;               # CONVERT TIME/DATE TO BINARY #
        PROC FILINFO;                # GET FILE INFORMATION # 
        PROC MEMORY;                 # REQUEST MEMORY # 
        PROC PAP;                    # PROCESS *ACPD* PARAMETER # 
        PROC PERROR;                 # PROCESS ERROR #
        PROC READRC;                 # READ ONE RECORD FROM DATA FILE # 
        PROC REPTLE;                 # PRINT REPORT SUBTITLE #
        PROC RPOPEN;                 # OPEN FILES # 
        PROC ZSETFET;                # INITIALIZE *CIO* FET # 
        END 
  
# 
****  PROC INITLZ - XREF LIST END.
# 
  
      DEF CNIC       #"CNIL"#;       # FAST LOOP SAMPLE # 
      DEF CTMC       #"CTML"#;       # MEDIUM LOOP SAMPLE # 
      DEF CTOC       #"CTOL"#;       # SLOW LOOP SAMPLE # 
      DEF MXVC       #1.0E20#;       # MAXIMUM VALUE #
      DEF NA         #"NA"#;         # NO ABORT FLAG #
      DEF RECALL     #1#;            # RECALL FLAG #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM BA         I;             # BYTE ADDRESS # 
      ITEM CM         C(10)="CM";    # REQUEST CM FLAG #
      ITEM D          I;             # TEMPORARY VARIABLE # 
      ITEM DM         I;             # TEMPORARY VARIABLE # 
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM STAT       I;             # I/O STATUS # 
      ITEM T          I;             # TEMPORARY VARIABLE # 
      ITEM TM         I;             # TIME # 
  
      ARRAY FINFO [0:0] P(5);        # *FILINFO* PARAMETER BLOCK #
        BEGIN  # ARRAY FINFO #
        ITEM FIN$FN     C(00,00,07);  # FILE NAME # 
        ITEM FIN$LN     U(00,42,06)=[5];  # PARAMETER BLOCK LENGTH #
        ITEM FIN$US     U(00,48,12)=[1];  # COMPLETION STATUS # 
        ITEM FIN$WD     U(01,00,60);  # PARAMETER BLOCK WORD #
        ITEM FIN$EI     B(01,36,01);  # EOI STATUS #
        ITEM FIN$EF     B(01,37,01);  # EOF STATUS #
        ITEM FIN$BI     B(01,38,01);  # BOI STATUS #
        END  # ARRAY FINFO #
  
      ARRAY STT [0:0] P(1);          # MEMORY ARGUMENT #
        BEGIN  # ARRAY STT #
        ITEM STT$RFL    U(00,00,30);  # REQUEST FIELD LENGTH #
        END  # ARRARY STT # 
  
  
  
  
  
  
  
# 
*     BEGIN INITLZ PROC.
# 
  
      PAP;                           # PROCESS *ACPD* PARAMETERS #
  
# 
*     OPEN FILES. 
# 
  
      ZSETFET(LOC(FETI),P$FN,LOC(WSAI),WSAL+1,FENL+1);
      FIN$FN[0]=P$FN; 
      FILINFO(FINFO);                # CHECK STATUS OF INPUT FILE # 
      IF (FIN$WD[0] EQ NULL)        # NO STATUS # 
      THEN
        BEGIN 
        PERROR(ERM11,FATAL,P$FN);    # DATA FILE NOT FOUND #
        END 
  
      IF (FIN$EI[0])                 # EOI #
      THEN
        BEGIN 
        PERROR(ERM12,FATAL,NULL);    # DATA FILE POSITIONED AT EOI #
        END 
  
      IF (NOT (FIN$EF[0] OR FIN$BI[0]))  # NOT AT EOF NOR BOI # 
      THEN
        BEGIN 
        PERROR(ERM7,FATAL,NULL);
        END 
  
      OFFA=LOC(FETO); 
      IF (P$L NQ NULL)               # REPORT FILE SPECIFIED #
      THEN                           # OPEN REPORT FILE # 
        BEGIN 
        RPOPEN(P$L,OFFA,REPTLE);
        END 
  
      IF (P$S NQ NULL)               # SUMMARY FILE SPECIFIED # 
      THEN                           # OPEN SUMMARY FILE #
        BEGIN 
        ZSETFET(LOC(FETS),P$S,LOC(WSAS),WSAL+1,FENL+1); 
        END 
  
# 
*     REQUEST CURRENT FIELD LENGTH. 
# 
  
      MEMORY(CM,STT,RECALL,NA); 
      CRFL=STT$RFL[0];               # CURRENT FIELD LENGTH # 
      HGAD=CRFL;                     # HIGHEST ADDRESS #
  
# 
*     CHECK IF *CPD* AND *ACPD* VERSIONS ARE THE SAME.
# 
  
      READRC(STAT);                  # READ HEADER BLOCK #
      IF (STAT NQ EORC)              # EOF OR EOI ENCOUNTERED # 
      THEN
        BEGIN 
        PERROR(ERM5,FATAL,NULL);     # DATA FILE EMPTY #
        END 
  
      IF (P$VERS NQ WSAI$VS[0])      # *CPD* AND *ACPD* INCOMPATBLE # 
      THEN
        BEGIN 
        PERROR(ERM13,FATAL,NULL);    # CPD/ACPD VERSIONS MISMATCH # 
        END 
  
# 
*     VALIDATE BEGIN AND END TIMES. 
*     IF NO *BD* SPECIFIED, BEGIN DATE IS THE DATE OF THE 
*     HEADER RECORD OF THE CURRENT FILE.
*     IF NO *ED* SPECIFIED, END DATE IS THE SAME AS BEGIN DATE. 
*     IF NO *ET*/*ED* SPECIFIED, END DATE IS SET TO MAXIMUM.
# 
  
      P<DCHD>=LOC(DBUF);
      P<DDSC>=LOC(DDHD);
  
      IBWA=0; 
      DECODE(LOC(HDTR),LOC(DCHD));   # DECODE HEADER BLOCK #
      ADJUST;                        # ADJUST TABLES AND FIELD LENGTH # 
      HDDC=TRUE;                     # HEADER BLOCK HAS BEEN DECODED #
  
      IF (P$BD EQ NULL)              # NO BEGINNING DATE #
      THEN
        BEGIN 
        DM=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC; 
        END 
  
      ELSE                           # *BD* SPECIFIED # 
        BEGIN 
        DM=DTMNUM(P$BD,FALSE,TRUE)*SHFC;
        END 
  
      P$BT=DM + DTMNUM(P$BT,FALSE,FALSE); 
  
      IF (P$ED NQ NULL)              # END DATE SPECIFIED # 
      THEN
        BEGIN 
        P$ET=(DTMNUM(P$ED,FALSE,TRUE)*SHFC) + DTMNUM(P$ET,FALSE,FALSE); 
        END 
  
      ELSE                           # NO END DATE #
        BEGIN 
        IF (P$ET NQ NULL)            # END TIME SPECIFIED # 
        THEN
          BEGIN 
          P$ET=DM + DTMNUM(P$ET,FALSE,FALSE); 
          END 
  
        ELSE                         # *ET*/*ED* ARE NOT SPECIFIED #
          BEGIN 
          P$ET=MXDC*SHFC + MXTC;     # 33/12/31  23.59.59 # 
          END 
  
        END 
  
      IF (P$BT GQ P$ET)              # BEGIN TIME .GE. END TIME # 
      THEN
        BEGIN 
        EDTM=TRUE;                   # ENDING TIME REACHED #
        RETURN; 
        END 
  
      TM=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC; 
      TM=TM + DTMNUM(DCHD$WD[DDSC$FW[TIME]],TRUE,FALSE);
      IF (P$BT GR TM)                # *BT* .GT. TIME OF FIRST
                                       DATA RECORD #
      THEN
        BEGIN 
        DTDC=TRUE;                   # DECODE DATA BLOCK #
        END 
  
      ELSE
        BEGIN 
        DTDC=FALSE;                  # NOT DECODE DATA BLOCK #
        END 
  
# 
*     COMPUTE BYTE ADDRESSES OF SAMPLE TIMES IN 
*     INPUT FILE-S WORKING STORAGE AREA.
# 
  
      BA=0; 
      P<MPAR>=LOC(DATT);
      SLOWFOR I=0 STEP 1 WHILE (MPAR$NM[I] NQ CTOC) 
      DO
        BEGIN  # COMPUTE SAMPLE TIME BYTE ADDRESS # 
        IF (MPAR$NM[I] EQ CNIC)      # FAST LOOP SAMPLE # 
        THEN
          BEGIN 
          SPLA$WD[MPAR$TP[I]]=BA; 
          END 
  
        ELSE
          BEGIN 
          IF (MPAR$NM[I] EQ CTMC)    # MEDIUM LOOP SAMPLE # 
          THEN
            BEGIN 
            SPLA$WD[MPAR$TP[I]]=BA; 
            END 
  
          END 
  
        BA=MPAR$LN[I]*MPAR$PR[I] + BA;
        END  # COMPUTE SAMPLE TIME BYTE ADDRESS # 
  
      SPLA$WD[MPAR$TP[I]]=BA;        # SLOW LOOP SAMPLE # 
  
      READRC(STAT);                  # READ FIRST DATA BLOCK #
      IF (STAT NQ EORC)              # NO DATA BLOCKS # 
      THEN
        BEGIN 
        PERROR(ERM4,FATAL,NULL);     # DATA BLOCKS MISSING #
        END 
  
      P<DCDT>=LOC(DBUF[DCHL]);
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
  
# 
*     POSITION FILE AT CORRECT RECORD.
# 
  
      STAT=0; 
      IBWA=0; 
  
      SLOWFOR J=0 WHILE (P$BT GR TM) AND (STAT NQ EOIC) 
      DO
        BEGIN  # READ FILE #
        IF (IBWA GQ IBNW)            # INPUT BUFFER EXHAUSTED # 
        THEN
          BEGIN  # GET NEXT BUFFER #
          READRC(STAT);              # READ NEXT RECORD # 
          IBWA=0; 
          IF (STAT NQ EORC)          # END OF CURRENT FILE #
          THEN
            BEGIN  # CHECK IF EOF OR EOI #
            IF (STAT EQ EOFC)        # PREVIOUS READ ENCOUNTERED EOF #
            THEN
              BEGIN  # GET NEXT FILE #
              READRC(STAT);          # READ HEADER BLOCK OF NEXT FILE # 
              IF (STAT NQ EORC)      # NO DATA BLOCKS FOLLOW #
              THEN
                BEGIN 
                PERROR(ERM4,FATAL,NULL);   # DATA BLOCKS MISSING #
                END 
  
              DECODE(LOC(HDTR),LOC(DCHD));  # DECODE HEADER BLOCK # 
              ADJUST;                # ADJUST TABLES AND FIELD LENGTH # 
              P<DCDT>=LOC(DBUF[DCHL]);
              P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
              P<DDSC>=LOC(DDHD);
  
              D=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC;
                                     # GET DATE ON RECORD # 
              T=DTMNUM(DCHD$WD[DDSC$FW[TIME]],TRUE,FALSE);
                                     # GET TIME ON RECORD # 
              IF (TM GR (D+T))       # PREVIOUS TIME .GT. 
                                       CURRENT TIME # 
              THEN
                BEGIN 
                PERROR(ERM8,FATAL,NULL);
                END 
  
              TM=D + T;              # SET TO CURRENT TIME #
              TEST J;                # GO PROCESS DATA BLOCKS # 
              END  # GET NEXT FILE #
  
            ELSE                     # PREVIOUS READ ENCOUNTERD *EOI* # 
              BEGIN 
              PERROR(ERM3,FATAL,NULL);   # BT/BD NOT FOUND #
              END 
  
            END  # CHECK IF EOF OR EOI #
  
          END  # GET NEXT BUFFER #
  
        DECODE(LOC(DATT),LOC(DCDT));
        P<DDSC>=LOC(DDDT);
        TM=DCDT$WD[DDSC$FW[PDTM]];   # GET TIME # 
  
# 
*     REINITIALIZE BUFFER OF FIRST COLUMN.
# 
  
        FASTFOR I=0 STEP 1 UNTIL DCDL - 1 
        DO
          BEGIN 
          DCDT$WD[I]=0; 
          DCDT$WD[I + DCDL*DCDC]=0; 
          DDSM$IM[I]=0; 
          DDSM$IQ[I]=0; 
          END 
  
        END  # READ FILE #
  
      IF (P$ET LQ TM)                # READ PAST ENDING TIME #
      THEN
        BEGIN 
        EDTM=TRUE;
        END 
  
      RETURN; 
      END  # INITLZ # 
  
      TERM
PROC PERROR((ERCD),(EROR),(ERNM));
# TITLE PERROR - ISSUE ERROR MESSAGE.  #
  
      BEGIN  # PERROR # 
  
# 
**    PERROR - ISSUE ERROR MESSAGE. 
* 
*     ISSUE ERROR MESSAGE TO THE USER DAYFILE AND ABORT 
*     THE JOB IF THE ERROR IS FATAL.
* 
*     PROC PERROR(ERCD,EROR,ERNM) 
* 
*     ENTRY      ERCD = ERROR CODE. 
*                EROR = ERROR LEVEL.
*                ERNM = ERROR NAME. 
* 
*     EXIT       JOB ABORTED IF *EROR*=FATAL. 
*                OTHERWISE, RETURN TO CALLING PROGRAM.
* 
*     MESSAGES
* 
*     1. ACPD ARGUMENT ERROR - XX.
*     2. ACPD/CPD VERSIONS MISMATCH.
*     3. BT/BD NOT FOUND. 
*     4. DATA BLOCKS MISSING. 
*     5. DATA ELEMENT NAME UNDEFINED - XXXX.
*     6. DATA FILE CONTENT ERROR. 
*     7. DATA FILE EMPTY. 
*     8. DATA FILE NOT AT BEGINNING OF FILE.
*     9. DATA FILE NOT FOUND - XXXXXXX. 
*    10. DATA FILE NOT IN CHRONOLOGICAL ORDER.
*    11. DATA FILE POSITIONED AT EOI. 
*    12. IN AND IC PARAMETER CONFLICT.
*    13. IN LESS THAN FILE WRITE TIME.
*    14. N EXCEEDS NUMBER OF FILES. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM ERCD       I;             # ERROR CODE # 
      ITEM EROR       I;             # ERROR LEVEL #
      ITEM ERNM       C(10);         # ERROR NAME # 
  
# 
****  PROC PERROR - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABORT JOB #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGES # 
        END 
  
# 
****  PROC PERROR - XREF LIST END.
# 
  
      DEF BLKC       #" "#;          # BLANK #
      DEF DOLC       #"$"#;          # DOLLAR SIGN #
      DEF PRDC       #"."#;          # PERIOD # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM L          I;             # FOR LOOP CONTROL # 
  
      ARRAY ERMS [1:ERMSC] S(4);     # ERROR MESSSAGES #
        BEGIN  # ARRAY ERMS # 
        ITEM ER$MS      C(00,00,38) =  # ERROR MESSAGES # 
  
                      [" ACPD ARGUMENT ERROR - $.", 
                       " DATA ELEMENT NAME UNDEFINED - $.", 
                       " BT/BD NOT FOUND.", 
                       " DATA BLOCKS MISSING.", 
                       " DATA FILE EMPTY.", 
                       " DATA FILE CONTENT ERROR.", 
                       " DATA FILE NOT AT BEGINNING OF FILE.",
                       " DATA FILE NOT IN CHRONOLOGICAL ORDER.",
                       " N EXCEEDS NUMBER OF FILES.", 
                       " IN LESS THAN FILE WRITE TIME.",
                       " DATA FILE NOT FOUND - $.", 
                       " DATA FILE POSITIONED AT EOI.", 
                       " ACPD/CPD VERSIONS MISMATCH.",
                       " IN AND IC PARAMETER CONFLICT."]; 
  
        ITEM ER$ZR      C(03,48,02) = [0,0,0,0,0,0,0,0,0,0,0,0,0,0];
                                     # ZERO FILLED LAST BYTE #
        END  # ARRAY ERMS # 
  
  
  
  
  
# 
*     BEGIN PERROR PROC.
# 
  
      IF (ERNM NQ 0)                 # NAME SPECIFIED # 
      THEN
        BEGIN  # FILL IN ERROR NAME # 
        SLOWFOR J=2 STEP 1 WHILE (C<J,1>ER$MS[ERCD] NQ DOLC)
        DO;                          # LOOK FOR DOLLAR SIGN # 
  
        SLOWFOR L=0 STEP 1 WHILE (C<L,1>ERNM NQ 0)
          AND (C<L,1>ERNM NQ BLKC)
        DO
          BEGIN 
          C<J,1>ER$MS[ERCD]=C<L,1>ERNM; 
          J=J+1;
          END 
  
        C<J,1>ER$MS[ERCD]=PRDC; 
        END  # FILL IN ERROR NAME # 
  
      MESSAGE(ER$MS[ERCD],3);        # ISSUE ERROR MESSAGE #
      IF (EROR NQ FATAL)
      THEN
        BEGIN 
        RETURN;                      # TO CALLING PROGRAM # 
        END 
  
      ABORT;
      END  # PERROR # 
  
      TERM
PROC PRDTEL((PVL),(DTY),(TMX)); 
# TITLE PRDTEL - PRINT ONE LINE OF DATA ELEMENT.  # 
  
      BEGIN  # PRDTEL # 
  
# 
**    PRDTEL - PRINT ONE LINE OF DATA ELEMENT.
* 
*     PRINT VALUES IN ONE LINE OF ONE DATA ELEMENT. 
* 
*     PROC PRDTEL((PVL),(DTY),(TMX))
* 
*     ENTRY      PVL = POINTER TO VALUES. 
*                DTY = DATA TYPE. 
*                TMX = POINTER TO CURRENT TOTAL MAXIMUM AND 
*                      MINIMUM VALUES.
* 
*     EXIT       ONE ROW OF THE DATA ELEMENT-S VALUES ARE PRINTED.
*                THE SUBTOTAL IS ALSO PRINTED, ALONG WITH THE 
*                MAXIMUM AND MIN VALUES OF THAT ROW.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM PVL        U;             # POINTER TO VALUES #
      ITEM DTY        I;             # DATA TYPE #
      ITEM TMX        U;             # POINTER TO TOTAL MAXIMUM VALUE # 
  
# 
****  PROC PRDTEL - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC DETMXM;                 # DETERMINE MAXIMUM AND MINIMUM #
        PROC WRITEV;                 # WRITE VALUE #
        END 
  
# 
****  PROC PRDTEL - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM CL         I;             # COLUMN # 
      ITEM CR         I;             # CARRIAGE CONTROL # 
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM IC         I;             # INCREMENTOR #
      ITEM MN         I;             # MINIMUM INTERVAL # 
      ITEM MX         I;             # MAXIMUM INTERVAL # 
      ITEM X          R;             # TEMPORARY VARIABLE # 
  
      BASED 
      ARRAY MXN [0:0] S(2);          # TOTAL MAXIMUM/MINIMUM VALUES # 
        BEGIN  # ARRAY MXN #
        ITEM MXN$MX     R(00,00,60);  # TOTAL MAXIMUM VALUE # 
        ITEM MXN$MN     R(01,00,60);  # TOTAL MINIMUM VALUE # 
        END  # ARRAY MXN #
  
      BASED 
      ARRAY VAL [1:11] P(1);         # VALUES TO BE PRINTED # 
        BEGIN  # ARRAY VAL #
        ITEM VL$F       R(00,00,60);  # REAL VALUE #
        ITEM VL$N       I(00,00,60);  # INTEGER VALUE # 
        END  # ARRAY VAL #
  
  
  
  
  
# 
*     BEGIN PRDTEL PROC.
# 
  
      IF (NIPP LQ (DCDC-3))          # PRINT TOTAL ON SAME LINE # 
      THEN                           # DO NOT LINE FEED # 
        BEGIN 
        CR=NLFC;
        END 
  
      ELSE
        BEGIN 
        CR=LFDC;                     # LINE FEED #
        END 
  
# 
*     DETERMINE MINIMUM AND MAXIMUM INTERVALS.
# 
  
      P<VAL>=PVL; 
      P<MXN>=TMX; 
      MX=1; 
      MN=1; 
      FASTFOR I=1 STEP 1 UNTIL NIPP 
      DO
        BEGIN  # FIND MAXIMUM AND MINIMUM COLUMNS # 
        IF (VL$F[I] GR VL$F[MX])
        THEN
          BEGIN 
          MX=I;                      # CURRENT MAXIMUM POSITION # 
          END 
  
        IF (VL$F[I] LS VL$F[MN])
        THEN
          BEGIN 
          MN=I;                      # CURRENT MINIMUM POSITION # 
          END 
  
        END  # FIND MAXIMUM AND MINIMUM COLUMNS # 
  
# 
*     UPDATE CURRENT VALUES OF TOTAL MAXIMUM AND MINIMUM. 
# 
  
      IF (VL$F[MX] GR MXN$MX[0])     # INTERVAL MAXIMUM .GT.
                                       TOTAL MAXIMUM #
      THEN
        BEGIN 
        MXN$MX[0]=VL$F[MX];          # UPDATE TOTAL MAXIMUM # 
        END 
  
      IF (VL$F[MN] LS MXN$MN[0])     # INTERVAL MINIMUM .LT.
                                       TOTAL MINIMUM #
      THEN
        BEGIN 
        MXN$MN[0]=VL$F[MN];          # UPDATE TOTAL MINIMUM # 
        END 
  
      IF (DTY NQ FLPC)               # NOT FLOATING POINT # 
      THEN                           # CONVERT VALUES TO INTEGER #
        BEGIN 
        FASTFOR I=1 STEP 1 UNTIL NIPP+1 
        DO
          BEGIN 
          X=VL$F[I];
          VL$N[I]=X;
          END 
  
        END 
  
# 
*     NOW PRINT THE VALUES IN ONE LINE STARTING FROM
*     COLUMN *BCLC*.
# 
  
      CL=BCLC;
      FASTFOR I=1 STEP 1 UNTIL NIPP 
      DO
        BEGIN 
        WRITEV(VL$F[I],DTY,CL,10,NLFC); 
        CL=CL+10; 
        END 
  
# 
*     INDICATE MINIMUM AND MAXIMUM INTERVAL VALUES BY ENCLOSING 
*     THEM IN PARENTHESES AND BRACKETS, RESPECTIVELY. 
# 
  
      IF (MX NQ MN) 
      THEN
        BEGIN 
        DETMXM(VL$F[MX],VL$F[MN],MX,MN,DTY);
        END 
  
      IF (TCOL GR (DCDC-3)) 
      THEN
        BEGIN 
        WRITEV(VL$F[NIPP+1],DTY,CL+1,9,CR);   # WRITE SUBTOTAL #
        END 
  
      RETURN; 
      END  # PRDTEL # 
  
      TERM
PROC PUTBLK((NSF),(FWA),(LWA)); 
# TITLE PUTBLK - PRINT ELEMENTS OF ONE LOOP OF DATA BLOCK.  # 
  
      BEGIN  # PUTBLK # 
  
# 
**    PUTBLK - PRINT ELEMENTS OF ONE LOOP OF DATA BLOCK.
* 
*     PUTBLK IS THE DRIVER IN PRINTING THE DATA BLOCK ELMENTS 
*     (FAST LOOP, MEDIUM LOOP, SLOW LOOP).
* 
*     PROC PUTBLK((NSF),(FWA),(LWA))
* 
*     ENTRY      NSF = NUMBER OF RECORDS PER INTERVAL.
*                FWA = FIRST WORD ADDRESS OF LOOP IN TABLE *DSPT*.
*                LWA = LAST WORD ADDRESS OF LOOP IN TABLE *DSPT*. 
* 
*     EXIT       DATA ELEMENTS OF ONE LOOP ARE PRINTED BY THE 
*                ORDER SPECIFIED IN TABLE *DSPT*. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM NSF        I;             # NUMBER OF RECORDS PER INTERVAL # 
      ITEM FWA        I;             # *FWA* OF BLOCK IN *DSPT* TABLE # 
      ITEM LWA        I;             # *LWA* OF BLOCK IN *DSPT* TABLE # 
  
# 
****  PROC PUTBLK - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC DATELM;                 # PROCESS ONE DATA BLOCK ELEMENT # 
        PROC GETMSG;                 # GET MESSAGE FROM *DSPTTXT* # 
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        END 
  
# 
****  PROC PUTBLK - XREF LIST END.
# 
  
      DEF BLKC       #" "#;          # BLANK #
      DEF NSBC       #O"777"#;       # NO SUBBLOCK FLAG # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM CT         I;             # INDEX OF *DSPT* TABLE #
      ITEM FG         B;             # FLAG TO PRINT SUBBLOCK TITLE # 
      ITEM FW         I;             # INDEX OF *DCDT* TABLE #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM IC         I;             # INCREMENTOR #
      ITEM J          I;             # INDEX #
      ITEM LN         I;             # LENGTH OF DATA ITEM #
      ITEM MS1        C(50);         # TEMPORARY BUFFER # 
      ITEM POS        I;             # RELATIVE POSITION OF *WFP* # 
      ITEM PT         I;             # INDEX OF *DDDT* TABLE #
      ITEM SM         I;             # SAMPLE TIMES # 
      ITEM ST         I;             # POINTER TO SUBTABLE #
      ITEM SUM        I;             # SAMPLE TIMES SUBTOTAL #
      ITEM T          I;             # TEMPORARY STORAGE #
      ITEM TY         I;             # DATA TYPE #
      ITEM WA         I;             # WEIGHT FACTOR INFORMATION #
      ITEM WIC        I;             # INCREMENTOR OF WEIGHT FACTOR # 
      ITEM WP         I;             # WEIGHT FACTOR #
  
      ARRAY MS2 [0:2] P(1);          # SUBBLOCK MESSAGE BUFFER #
        BEGIN  # ARRAY MS2 #
        ITEM MS2$MS     C(00,00,10)=[" "," "," "];  # MESSAGE BUFFER #
        END  # ARRAY MS2 #
  
  
  
  
  
# 
*     BEGIN PUTBLK PROC.
# 
  
      P<DCDT>=LOC(DBUF[DCHL]);
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
      PT=DSPT$PT[FWA];               # POINTER TO *DDDT* #
      GETMSG(FWA,MS1);
      WRITEV(MS1,CHRC,1,22,NLFC); 
  
# 
*     PRINT SAMPLE TIMES. *NIPP* IS THE NUMBER OF COLUMNS PER PAGE. 
# 
  
      J=BCLC;                        # STARTING POSITION TO PRINT # 
      SUM=0;
      P<DDSC>=LOC(DDDT);
  
      SLOWFOR I=1 STEP 1 UNTIL NIPP 
      DO
        BEGIN 
        SM=DCDT$WD[(I-1)*DCDL + DDSC$FW[PT]]; 
        WRITEV(SM,INTC,J,10,NLFC);
        SUM=SUM+SM; 
        J=J+10; 
        END 
  
      IF (NIPP GR (DCDC-3))          # MORE THAN 7 COLUMNS #
      THEN                           # NO TOTAL ON THIS PAGE #
        BEGIN 
        WRITEV(SUM,INTC,J,10,LFDC);  # PRINT SUBTOTAL # 
        END 
  
      ELSE                           # PRINT TOTAL ON SAME PAGE # 
        BEGIN 
        IF (NIPP GR 0)               # MORE THAN 1 COLUMN COLLECTED # 
          AND (TCOL GR (DCDC-3))
        THEN                         # PRINT SUBTOTAL # 
          BEGIN 
          WRITEV(SUM,INTC,J,10,NLFC); 
          J=J+10; 
          END 
  
        SUM=DDSM$IM[DDSC$FW[PT]];    # TOTAL SAMPLES #
        WRITEV(SUM,INTC,J,10,LFDC); 
        END 
  
# 
*     COMPUTE AND PRINT LOOP ELEMENTS.
*     THE PROCESSING OF THE LOOP ELEMENTS WILL FOLLOW THE 
*     INSTRUCTIONS CONTAINED IN THE *DSPT* TABLE FROM 
*     *FWA* TO *LWA*. 
# 
  
      CT=FWA+1; 
      FASTFOR I=0 WHILE (CT LQ LWA) 
      DO
        BEGIN  # FOLLOW TABLE *DSPT* #
        PT=DSPT$PT[CT];              # POINTER TO *DDSC* TABLE #
        IF NOT (DDSC$SD[PT])         # ELEMENT IS NOT SELECTED #
        THEN
          BEGIN 
          CT=CT+1;
          TEST I;                    # SKIP IT #
          END 
  
        ST=DSPT$ST[CT];              # POINTER TO SUBTITLE TABLE #
        GETMSG(CT,MS1); 
        WA=DDSC$WA[PT];              # WEIGHT FACTOR INFORMATION #
        WP=DDSC$WP[PT];              # WEIGHT FACTOR #
        IF (WA EQ WGFC)              # WEIGHT FACTOR SPECIFIED #
        THEN
          BEGIN  # CHECK IF MULTIPLE WEIGHT FACTORS # 
          P<DDSC>=LOC(DDHD);
          IF (DDSC$LN[WP] GR 1)      # MORE THAN 1 WEIGHT FACTOR #
          THEN
            BEGIN 
            WIC=DDSC$IC[WP];         # WEIGHT FACTOR INCREMENTOR #
            END 
  
          ELSE
            BEGIN 
            WIC=0;
            END 
  
          P<DDSC>=LOC(DDDT);
          END  # CHECK IF MULTIPLE WEIGHT FACTORS # 
  
        TY=DDSC$TY[PT];              # DATA TYPE #
        FW=DDSC$FW[PT];              # POINTER TO *DCDT* TABLE #
        LN=DDSC$LN[PT];              # NUMBER OF ENTRIES #
        IC=DDSC$IC[PT];              # INCREMENTOR #
  
# 
*     IF THE POINTER TO SUBBLOCK TITLE TABLE *ST* IS NIL (*NSBC*),
*     THE ELEMENT IS A SINGLE ENTRY ELEMENT OR HAS NO SUBTITLES.
# 
  
  
        IF (ST EQ NSBC)              # SINGLE ENTRY OR NO SUBTITLE #
        THEN
          BEGIN  # PROCESS SINGLE ENTRY OR NO SUBTITLE ELEMENT #
          FG=FALSE;                  # DO NOT PRINT SUBBLOCK TITLE #
          POS=0;                     # FIRST WEIGHT FACTOR POSITION # 
          SLOWFOR J=1 STEP 1 WHILE (J LS LN)
          DO
            BEGIN 
            DATELM(FG,BLKC,MS1,WA,WP,POS,TY,FW,NSF);
            CT=CT+1;
            GETMSG(CT,MS1); 
            FW=FW+IC; 
            POS=POS+WIC;
            END 
  
          DATELM(FG,BLKC,MS1,WA,WP,POS,TY,FW,NSF);
          END  # PROCESS SINGLE ENTRY OR NO SUBTITLE ELEMENT #
  
# 
*     THE ELEMENT HAS SUBTITLES TO BE PROCESS. EACH ENTRY OF THE
*     MULTIPLE-ENTRY ELEMENT HAS A SUBTITLE DEFINED IN TABLE *SMGT*.
# 
  
        ELSE
          BEGIN  # MULTIPLE ENTRIES # 
          T=ST; 
          FG=TRUE;                   # PRINT SUBBLOCK # 
          POS=0;
          FASTFOR J=1 STEP 1 UNTIL LN 
          DO
            BEGIN  # PROCESS ONE ENTRY OF MULTIPLE-ENTRY ELEMENT #
            MS2$MS[1]=SMGT$TX[T]; 
            IF (MS2$MS[1] EQ BLKC)   # END OF SUBBLOCK TABLE #
            THEN
              BEGIN 
              T=ST;                  # RESET *SMGT* POINTER # 
              CT=CT+1;               # NEXT *DSPT* ELEMENT #
              GETMSG(CT,MS1); 
              MS2$MS[1]=SMGT$TX[T]; 
              FG=TRUE;               # PRINT SUBBLOCK # 
              END 
  
            DATELM(FG,MS1,MS2,WA,WP,POS,TY,FW,NSF); 
  
            T=T+1;
            FW=FW+IC; 
            POS=POS+WIC;
            END  # PROCESS ONE ENTRY OF MULTIPLE-ENTRY ELEMENT #
  
          END  # MULTIPLE ENTRIES # 
  
        CT=CT+1;
        END  # FOLLOW TABLE *DSPT* #
  
      END  # PUTBLK # 
  
      TERM
PROC PUTDAT((NSF),(NIN)); 
# TITLE PUTDAT - PRINT DATA BLOCK ELEMENTS.  #
  
      BEGIN  # PUTDAT # 
  
# 
**    PUTDAT - PRINT DATA BLOCK ELEMENTS. 
* 
*     PRINT FAST, MEDIUM, SLOW, AND SNAPSHOT LOOPS. 
* 
*     PROC PUTDAT((NSF),(NIN))
* 
*     ENTRY      NSF = NUMBER OF RECORDS PER INTERVAL.
*                NIN = NUMBER OF INTERVALS PER PAGE.
*                TABLE *DCDT* CONTAINS DATA BLOCK ELEMENT VALUES. 
* 
*     EXIT       DATA BLOCK ELEMENTS ARE PRINTED TO THE REPORT
*                FILE.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM NSF        I;             # NUMBER OF RECORDS PER INTERVAL # 
      ITEM NIN        I;             # NUMBER OF INTERVALS PER PAGE # 
  
# 
****  PROC PUTDAT - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC PUTBLK;                 # PRINT ONE LOOP DATA ELEMENTS # 
        PROC PUTSNS;                 # PRINT SNAPSHOT LOOP ELEMENTS # 
        PROC RPEJECT;                # PAGE EJECT # 
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        END 
  
# 
****  PROC PUTDAT - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM FW         I;             # LOOP BEGINNING INDEX # 
      ITEM LW         I;             # LOOP ENDING INDEX #
      ITEM MSG        C(30)="**********************"; 
                                     # LOOP REPORT SEPARATOR #
  
  
  
  
  
# 
*     BEGIN PUTDAT PROC.
# 
  
      NIPP=NIN; 
      IF (P$L NQ NULL)               # REPORT FILE SPECIFIED #
      THEN
        BEGIN 
        RPEJECT(OFFA);               # PAGE EJECT # 
        END 
  
      P<DCHD>=LOC(DBUF);
      P<DDSC>=LOC(DDHD);
  
      IF (DCHD$WD[DDSC$FW[DLIL]] NQ 0)  # FAST LOOP WAS COLLECTED # 
      THEN
        BEGIN 
        FW=HDML;
        LW=FW+FSML-1; 
        PUTBLK(NSF,FW,LW);           # PROCESS FAST LOOP #
        WRITEV(MSG,CHRC,1,22,LFDC); 
        END 
  
      IF (DCHD$WD[DDSC$FW[DLML]] NQ 0)  # MEDIUM LOOP WAS COLLECTED # 
      THEN
        BEGIN 
        FW=HDML+FSML; 
        LW=FW+MDML-1; 
        PUTBLK(NSF,FW,LW);           # PROCESS MEDIUM LOOP #
        WRITEV(MSG,CHRC,1,22,LFDC); 
        END 
  
      IF (DCHD$WD[DDSC$FW[DLOL]] NQ 0)  # SLOW LOOP WAS COLLECTED # 
      THEN
        BEGIN 
        FW=HDML+FSML+MDML;
        LW=FW+SLML-1; 
        PUTBLK(NSF,FW,LW);           # PROCESS SLOW LOOP #
        WRITEV(MSG,CHRC,1,22,LFDC); 
        END 
  
      IF (NIN GR 0)                  # NUMBER OF COLUMNS .GT. 0 # 
        AND (DCHD$WD[DDSC$FW[DLFW]] NQ 0)  # SNAPSHOT WAS COLLECTED # 
      THEN
        BEGIN 
        FW=HDML+FSML+MDML+SLML; 
        LW=FW+SNML-1; 
        TLFG=2; 
        PUTSNS(FW,LW);               # PROCESS SNAPSHOT LOOP ELEMENTS # 
        TLFG=1; 
        END 
  
      RETURN; 
      END  # PUTDAT # 
  
      TERM
PROC PUTEST;
# TITLE PUTEST - PRINT *EST*.  #
  
      BEGIN  # PUTEST # 
  
# 
**    PUTEST - PRINT *EST*. 
* 
*     PRINT *EST* TABLE.
* 
*     PROC PUTEST 
* 
*     ENTRY      TABLE *DCHD* CONTAINS HEADER BLOCK ELEMENT VALUES. 
* 
*     EXIT       EST IS WRITTEN TO THE REPORT FILE. 
* 
*     NOTE. 
* 
*     THE SYMBOL *SROS* DEFINED IN THIS ROUTINE HAS TO HAVE 
*     THE SAME VALUE AS THE SYMBOL *SROS* DEFINED IN COMMON 
*     DECK *COMSCPS*. 
*     THE ITEMS *FATT* AND *FATL* HAVE TO BE CHANGED ACCORDINGLY
*     IF CHANGE IS MADE TO THE FILE TYPES.
# 
  
# 
****  PROC PUTEST - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC RPEJECT;                # PAGE EJECT # 
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        FUNC XCOD C(10);             # BINARY TO DISPLAY OCTAL #
        END 
  
# 
****  PROC PUTEST - XREF LIST END.
# 
  
      DEF BLKC       #" "#;          # BLANK #
      DEF CHSC       #"S"#;          # CHARACTER S #
      DEF CHXC       #"X"#;          # CHARACTER X #
      DEF MGMC       #"MT"#;         # *MT* TAPE #
      DEF MGNC       #"NT"#;         # *NT* TAPE #
      DEF MNSC       #"-"#;          # MINUS SIGN # 
      DEF MXMSA      #47#;           # MAXIMUM MS ALLOCATABLE DEVICE #
      DEF SROS       #8#;            # SECONDARY ROLLOUT DEVICE # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
*CALL     COMUEST 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM FATL       C(12) 
         = "TIORDPLBSRRN";           # FILES TYPE # 
      ITEM FATT       C(12);         # TEMPORARY BUFFER # 
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM L          I;             # FOR LOOP CONTROL # 
      ITEM M          I;             # TEMPORARY STORAGE #
      ITEM MSG        C(50);         # TEMPORARY BUFFER # 
      ITEM MXRS       I;             # NUMBER OF *MSAL* CATEGORIES #
      ITEM MSI        I;             # MST ORDINAL #
      ITEM MSIC       I;             # MST INCREMENTOR #
      ITEM MUI        I;             # MST ORDINAL #
      ITEM MUIC       I;             # MST INCREMENTOR #
      ITEM N          I;             # TEMPORARY STORAGE #
  
      ARRAY CHNN [0:1] P(1);         # CHANNELS # 
        BEGIN  # ARRAY CHNN # 
        ITEM CH         U(00,00,60);  # CHANNEL WORD #
        ITEM CHAPFLAG   B(00,48,01);  # CHANNEL ACCESS PATH FLAG #
        ITEM CHSTATUS   U(00,49,02);  # CHANNEL STATUS #
        ITEM CHNUMBER   U(00,55,05);  # CHANNEL NUMBER #
        END  # ARRAY CHNN # 
  
      ARRAY TEM [0:0] P(1);          # TEMPORARY BUFFER # 
        BEGIN  # ARRAY TEM #
        ITEM TEM$TYPE   U(00,01,11);  # EQUIPMENT TYPE #
        END  # ARRAY TEM #
  
  
  
  
  
# 
*     BEGIN PUTEST PROC.
# 
  
      P<DCHD>=LOC(DBUF);
      P<DDSC>=LOC(DDHD);
  
      TLFG=3;                        # INDICATES PRINTING EST # 
      RPEJECT(OFFA);
  
# 
*     PRINT EST ENTRY.
# 
  
      P<EST>=LOC(DCHD$WD[DDSC$FW[ESTB]]); 
      MSI=0;
      MSIC=DDSC$IC[TRKC]; 
      MUI=0;
      MUIC=DDSC$IC[MSUN]; 
  
      SLOWFOR I=0 STEP 1 UNTIL DCHD$WD[DDSC$FW[ESTL]] - 1 
      DO
        BEGIN  # PROCESS ONE EST ENTRY #
        IF (EST$EQDE[I] EQ NULL)     # ENTRY NOT DEFINED #
        THEN
          BEGIN 
          TEST I; 
          END 
  
        WRITEV(I,OC2C,4,3,NLFC);     # EST ORDINAL #
        TEM$TYPE[0]=EST$TYPE[I];
        WRITEV(TEM,CHRC,11,2,NLFC);  # DEVICE TYPE #
  
        IF EST$STATUS[I] EQ 0        # ON DEVICE #
        THEN
          MSG="ON"; 
        ELSE
          BEGIN 
          IF EST$STATUS[I] EQ 1      # IDLE DEVICE #
          THEN
            MSG="IDLE"; 
          ELSE
            BEGIN 
            IF EST$STATUS[I] EQ 2    # OFF DEVICE # 
            THEN
              MSG="OFF";
            ELSE                     # DOWN DEVICE #
              MSG="DOWN"; 
            END 
  
          END 
  
        WRITEV(MSG,CHRC,16,3,NLFC);  # DEVICE STATUS #
  
        IF (NOT EST$MS[I])           # NOT MASS STORAGE DEVICE #
        THEN
          BEGIN 
          N=EST$EQU[I]; 
          WRITEV(N,OC2C,22,2,NLFC);  # EQUIPMENT NUMBER # 
          N=EST$UN[I];
          WRITEV(N,OC2C,26,2,NLFC);  # UNIT NUMBER #
          END 
  
        ELSE                         # MASS STORAGE DEVICE #
          BEGIN 
          IF (EST$RMVE[I])           # REMOVABLE MASS STORAGE DEVICE #
          THEN
            BEGIN 
            N=DCHD$WD[DDSC$FW[MSUN]+MUI]; 
            WRITEV(N,OC2C,26,2,NLFC); 
            END 
  
          MUI=MUI + MUIC; 
          END 
  
# 
*     PRINT CHANNELS. 
# 
  
        CH[0]=EST$CHANA[I];          # CHANNEL A #
        CHAPFLAG[0]=EST$CHAAE[I];    # CHANNEL A ACCESS ENABLED FLAG #
        CHSTATUS[0]=EST$CHAST[I];    # CHANNEL A STATUS # 
        CH[1]=EST$CHANB[I];          # CHANNEL B #
        CHAPFLAG[1]=EST$CHBAE[I];    # CHANNEL B ACCESS ENABLED FLAG #
        CHSTATUS[1]=EST$CHBST[I];    # CHANNEL B STATUS # 
  
        FASTFOR L=0 STEP 1 UNTIL 1
        DO
          BEGIN  # PRINT CHANNEL NUMBER # 
          IF (CHAPFLAG[L])           # CHANNEL ACCESS PATH ENABLED #
          THEN
            BEGIN 
            IF (CHSTATUS[L] EQ 0)    # CHANNEL IS UP #
            THEN
              BEGIN 
              WRITEV(CHNUMBER[L],OC2C,30+3*L,2,NLFC); 
              END 
  
            ELSE
              BEGIN 
              WRITEV("**",CHRC,30+3*L,2,NLFC);
              END 
  
            END 
  
  
          END  # PRINT CHANNEL NUMBER # 
  
# 
*     PRINT EST ENTRY IN FULL WORD, AND DEVICE TRACK CAPACITY.
# 
  
        N=EST$LHDE[I];
        WRITEV(N,OC3C,42,10,NLFC);
        N=EST$RHDE[I];
        WRITEV(N,OC3C,52,10,NLFC);
        N=EST$LHAE[I];
        WRITEV(N,OC3C,63,10,NLFC);
        N=EST$RHAE[I];
        IF (NOT EST$MS[I])           # NOT MASS STORAGE DEVICE #
        THEN
          BEGIN 
          WRITEV(N,OC3C,73,10,LFDC);
          TEST I; 
          END 
  
        ELSE
          BEGIN  # MASS STORAGE DEVICE #
          WRITEV(N,OC3C,73,10,NLFC);
          N=DCHD$WD[DDSC$FW[TRKC] + MSI]; 
          WRITEV(N,OC2C,87,4,NLFC);  # TRACK CAPACITY # 
          MSI=MSI+MSIC; 
  
# 
*     PRINT THE MASS STORAGE ALLOCATION TABLE.
# 
  
          IF (I GR MXMSA)            # EST ORDINAL .GT. *MXMSA* # 
          THEN
            BEGIN 
            WRITEV(BLKC,CHRC,95,1,LFDC);  # LINE FEED # 
            END 
  
          ELSE                       # EST ORDINAL .LE. *MXMSA* # 
            BEGIN  # CHECK FILE TYPE ON THE DEVICE #
            FATT="------------";
            MXRS=DCHD$WD[DDSC$FW[CON8]];
            SLOWFOR J=0 STEP 1 UNTIL MXRS-1 
            DO
              BEGIN 
              L=DDSC$FW[MSAA] + J;
              IF (B<12+I,1>DCHD$WD[L] EQ 1) 
              THEN
                BEGIN 
                C<J,1>FATT=C<J,1>FATL;
                END 
  
              END 
  
            IF (EST$SYS[I])          # SYSTEM FILE ON DEVICE #
            THEN
              BEGIN 
              MSG=CHXC; 
              END 
  
            ELSE
              BEGIN 
              MSG=MNSC; 
              END 
  
            WRITEV(MSG,CHRC,94,1,NLFC); 
  
# 
*     PRINT THE THRESHOLD OF THE NUMBER OF SECTORS ROLLED IF
*     THE DEVICE IS SECONDARY ROLLOUT.
# 
  
            IF (C<SROS,1>FATT NQ CHSC)  # NOT SECONDARY ROLLOUT # 
            THEN
              BEGIN 
              WRITEV(FATT,CHRC,95,MXRS,LFDC); 
              END 
  
            ELSE                     # SECONDARY ROLLOUT #
              BEGIN 
              WRITEV(FATT,CHRC,95,MXRS,NLFC); 
              WRITEV("THRESHOLD = ",CHRC,109,12,NLFC);
              WRITEV(DCHD$WD[DDSC$FW[SROT]],OC1C,121,5,NLFC); 
              WRITEV("SECTORS",CHRC,127,7,LFDC);
              END 
  
            END  # CHECK FILE TYPE ON THE DEVICE #
  
          END  # MASS STORAGE DEVICE #
  
        END  # PROCESS ONE EST ENTRY #
  
      RETURN; 
      END  # PUTEST # 
  
      TERM
PROC PUTHDR;
# TITLE PUTHDR - PROCESS HEADER BLOCK.  # 
  
      BEGIN  # PUTHDR # 
  
# 
**    PUTHDR - PROCESS HEADER BLOCK.
* 
*     PRINT FIRST PAGE OF HEADER BLOCK ELEMENTS.
* 
*     PROC HEADER 
* 
*     ENTRY      TABLE *DCHD* CONTAINS HEADER BLOCK ELEMENT VALUES. 
* 
*     EXIT       HEADER BLOCK ELEMENTS ARE PRINTED TO THE REPORT
*                FILE.
# 
  
# 
****  PROC PUTHDR - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC HDRELM;                 # PROCESS HEADER BLOCK ELEMENT # 
        PROC RPEJECT;                # PAGE EJECT # 
        PROC RPSPACE;                # LINE FEED #
        PROC WRITEV;                 # WRITE ONE ELEMENT #
        END 
  
# 
****  PROC PUTHDR - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM MSG        C(50);         # TEMPORARY BUFFER # 
  
  
  
  
  
# 
*     BEGIN PUTHDR PROC.
# 
  
      TLFG=0;                        # INDICATES NO SUBTITLE #
      RPEJECT(OFFA);
      RPSPACE(OFFA,2,1);
  
# 
*     PRINT START DATE AND START TIME OF THE DATA FILE. 
# 
  
      HDRELM(0,11,34);               # START DATE # 
      HDRELM(1,11,34);               # START TIME # 
  
# 
*     PRINT *ACPD* PARAMETERS.
# 
  
      RPSPACE(OFFA,2,1);
      WRITEV("DATA FILE NAME",CHRC,11,14,NLFC); 
      WRITEV(P$FN,CHRC,40,7,LFDC);
      IF (P$IN NQ 0)
      THEN
        BEGIN 
        WRITEV("REPORT INTERVAL (MINUTES)",CHRC,11,25,NLFC);
        WRITEV(P$IN,INTC,37,10,LFDC); 
        END 
  
      ELSE
        BEGIN 
        WRITEV("REPORT INTERVAL (RECORDS)",CHRC,11,25,NLFC);
        WRITEV(P$IC,INTC,37,10,LFDC); 
        END 
  
      RPSPACE(OFFA,2,1);
      FASTFOR I=APPM STEP 1 UNTIL HWCF-1
      DO
        BEGIN 
        HDRELM(I,11,40);
        END 
  
# 
*     PRINT THE HARDWARE CONFIGURATION. 
# 
  
      RPSPACE(OFFA,2,1);
      FASTFOR I=HWCF STEP 1 UNTIL CMCF-1
      DO
        BEGIN 
        HDRELM(I,11,40);
        END 
  
# 
*     PRINT THE CMR CONFIGURATION.
# 
  
      RPSPACE(OFFA,2,1);
      FASTFOR I=CMCF STEP 1 UNTIL SASC-1
      DO
        BEGIN 
        HDRELM(I,11,40);
        END 
  
# 
*     PRINT THE SYSTEM ASSEMBLY CONSTANTS.
# 
  
      RPSPACE(OFFA,2,1);
      FASTFOR I=SASC STEP 1 UNTIL SDLP-1
      DO
        BEGIN 
        HDRELM(I,11,47);
        END 
  
# 
*     PRINT THE SYSTEM DELAY PARAMETERS.
# 
  
      RPSPACE(OFFA,2,1);
      FASTFOR I=SDLP STEP 1 UNTIL BFIO-1
      DO
        BEGIN 
        HDRELM(I,11,47);
        END 
  
# 
*     PRINT THE TOTAL NUMBER OF HIGH SPEED DISK BUFFERS 
*     AND EXTENDED MEMORY/PP BUFFERS. 
# 
  
      RPSPACE(OFFA,2,1);
      FASTFOR I=BFIO STEP 1 UNTIL HDML-1
      DO
        BEGIN 
        HDRELM(I,11,47);
        END 
  
      RETURN; 
      END  # PUTHDR # 
  
      TERM
PROC PUTSCI;
# TITLE PUTSCI - PRINT SYSTEM CONTROL INFORMATION.  # 
  
      BEGIN  # PUTSCI # 
  
# 
**    PUTSCI - PRINT SYSTEM CONTROL INFORMATION.
* 
*     PRINT SYSTEM CONTROL INFORMATION. 
* 
*     PROC PUTSCI 
* 
*     ENTRY      TABLE *DCHD* CONTAINS HEADER BLOCK ELEMENT VALUES. 
* 
*     EXIT       SYSTEM CONTROL INFORMATION (SERVICE CLASSES, 
*                PRIORITY, ETC.) ARE PRINTED TO THE REPORT FILE.
# 
  
# 
****  PROC PUTSCI - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC RPEJECT;                # PAGE EJECT # 
        PROC RPSPACE;                # LINE FEED #
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        END 
  
# 
****  PROC PUTSCI - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
*CALL     COMUJCA 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM VALUE      I;             # TEMPORARY STORAGE #
  
  
  
  
  
# 
*     BEGIN PUTSCI PROC.
# 
  
      TLFG=0;                        # INDICATES NO SUBTITLE #
      P<DCHD>=LOC(DBUF);
      P<DDSC>=LOC(DDHD);
  
      RPEJECT(OFFA);
      RPSPACE(OFFA,2,1);
      WRITEV("SYSTEM CONTROL INFORMATION",CHRC,11,26,LFDC); 
  
      RPSPACE(OFFA,2,1);
      WRITEV("SERVICE   QUEUE",CHRC,11,15,NLFC);
      WRITEV("               PRIORITIES",CHRC,26,25,NLFC);
      WRITEV("SERVICE LIMITS",CHRC,77,14,LFDC); 
  
      WRITEV("CLASS",CHRC,11,5,NLFC); 
      WRITEV("CP      CT    CM     NJ    TD",CHRC,69,29,LFDC);
  
      WRITEV("FL      AM    TP     AJ    DT",CHRC,69,29,LFDC);
  
      WRITEV("IL     LP     UP    WF    IP",CHRC,31,28,NLFC); 
      WRITEV("EC      EM    DS   FC  CS  FS",CHRC,69,29,LFDC);
  
      WRITEV("PR      SE    RS     US",CHRC,69,23,LFDC);
  
      P<JBCA>=LOC(DCHD$WD[DDSC$FW[JCBA]]);
  
# 
*     PRINT SERVICE CLASS INFORMATION.
# 
  
      SLOWFOR I=1 STEP 1 UNTIL DCHD$WD[DDSC$FW[MXNS]]-2 
      DO
        BEGIN  # PROCESS ONE SERVICE CLASS #
        RPSPACE(OFFA,2,1);
        WRITEV(JCST$SC[I],CHRC,13,2,NLFC);  # SERVICE CLASS NAME #
        WRITEV("IN",CHRC,22,2,NLFC);
        WRITEV(JCA$INLP[I],OC2C,36,4,NLFC); 
        WRITEV(JCA$INUP[I],OC2C,43,4,NLFC); 
        VALUE=2**JCA$INWF[I]; 
        WRITEV(VALUE,OC2C,49,4,NLFC); 
        WRITEV(JCA$CP[I],OC2C,67,4,NLFC); 
        WRITEV(JCA$CT[I],OC2C,75,4,NLFC); 
        WRITEV(JCA$CM[I],OC2C,81,4,NLFC); 
        WRITEV(JCA$NJ[I],OC2C,88,4,NLFC); 
        WRITEV(JCA$TD[I],OC2C,94,4,LFDC); 
  
        WRITEV("EX",CHRC,22,2,NLFC);
        WRITEV(JCA$EXIL[I],OC2C,29,4,NLFC); 
        WRITEV(JCA$EXLP[I],OC2C,36,4,NLFC); 
        WRITEV(JCA$EXUP[I],OC2C,43,4,NLFC); 
        VALUE=2**JCA$EXWF[I]; 
        WRITEV(VALUE,OC2C,49,4,NLFC); 
        WRITEV(JCA$EXIP[I],OC2C,55,4,NLFC); 
        WRITEV(JCA$FL[I],OC2C,67,4,NLFC); 
        WRITEV(JCA$AM[I],OC2C,71,8,NLFC); 
        WRITEV(JCA$TP[I],OC2C,81,4,NLFC); 
        WRITEV(JCA$AJ[I],OC2C,88,4,NLFC); 
        WRITEV(JCST$SC[JCA$DT[I]],CHRC,96,2,LFDC);
  
        WRITEV("OT",CHRC,22,2,NLFC);
        WRITEV(JCA$OTLP[I],OC2C,36,4,NLFC); 
        WRITEV(JCA$OTUP[I],OC2C,43,4,NLFC); 
        VALUE=2**JCA$OTWF[I]; 
        WRITEV(VALUE,OC2C,49,4,NLFC); 
        WRITEV(JCA$EC[I],OC2C,67,4,NLFC); 
        WRITEV(JCA$EM[I],OC2C,75,4,NLFC); 
        WRITEV(JCA$DS[I],OC2C,84,1,NLFC); 
        WRITEV(JCA$FC[I],OC2C,89,1,NLFC); 
        WRITEV(JCA$CS[I],OC2C,93,1,NLFC); 
        WRITEV(JCA$FS[I],OC2C,97,1,LFDC); 
  
        WRITEV(JCA$PR[I],OC2C,67,4,NLFC); 
        WRITEV(JCA$SE[I],OC2C,75,4,NLFC); 
        WRITEV(JCA$RS[I],OC2C,81,4,NLFC); 
        WRITEV(JCA$US[I],OC2C,88,4,LFDC); 
  
        END  # PROCESS ONE SERVICE CLASS #
  
      RETURN; 
      END  # PUTSCI # 
  
      TERM
PROC PUTSNS((FWA),(LWA)); 
# TITLE PUTSNS - PROCESS SNAPSHOT LOOP ELEMENTS.  # 
  
      BEGIN  # PUTSNS # 
  
# 
**    PUTSNS - PROCESS SNAPSHOT LOOP ELEMENTS.
* 
*     PUTSNS IS THE DRIVER OF THE SNAPSHOT LOOP ELEMENTS. 
* 
*     PROC PUTSNS((FWA),(LWA))
* 
*     ENTRY      FWA = FIRST WORD ADDRESS OF SNAPSHOT LOOP
*                      ELEMENTS IN TABLE *DSPT*.
*                LWA = LAST WORD ADDRESS OF SNAPSHOT LOOP 
*                      ELEMENTS IN TABLE *DSPT*.
* 
*     EXIT       SNAPSHOT LOOP ELEMENTS ARE PRINTED TO THE REPORT 
*                FILE.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM FWA        I;             # *FWA* IN *DSPT* TABLE #
      ITEM LWA        I;             # *LWA* IN *DSPT* TABLE #
  
# 
****  PROC PUTSNS - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC GETMSG;                 # GET TITLE FROM TABLE *DSPTTXT* # 
        PROC WRITEV;                 # WRITE DATA ELEMENT # 
        END 
  
# 
**** PROC PUTSNS - XREF LIST END. 
# 
  
      DEF BLKC       #" "#;          # BLANK #
      DEF BPCC       #6#;            # NUMBER OF BITS PER CHAR #
      DEF NSBC       #O"777"#;       # NO SUBBLOCK FLAG # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM BL         U;             # BIT LENGTH # 
      ITEM BT         I;             # BIT POSITION # 
      ITEM FW         I;             # POINTER TO *DCDT* TABLE #
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM IC         I;             # INCREMENTOR #
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM K          I;             # FOR LOOP CONTROL # 
      ITEM L          I;             # FOR LOOP CONTROL # 
      ITEM LN         U;             # TITLE LENGTH IN CHARACTERS # 
      ITEM MSG        C(50);         # TEMPORARY BUFFER # 
      ITEM N          I;             # TEMPORARY STORAGE #
      ITEM PT         I;             # POINTER TO *DDDT* TABLE #
      ITEM ST         U;             # POINTER TO SUBTITLE TABLE #
      ITEM VL         I;             # TEMPORARY VALUE #
      ITEM WC         I;             # WORD COUNT # 
  
  
  
  
  
  
# 
*     BEGIN PUTSNS PROC.
# 
  
      P<DCDT>=LOC(DBUF[DCHL]);
      P<DDSC>=LOC(DDDT);
  
      FASTFOR I=FWA STEP 1 UNTIL LWA
      DO
        BEGIN  # FOLLOW TABLE *DSPT* #
        PT=DSPT$PT[I];               # POINTER TO *DDSC* #
        ST=DSPT$ST[I];               # POINTER TO *SMGT* #
        BL=DSPT$BL[I];               # BIT LENGTH # 
        LN=DSPT$LN[I];
        GETMSG(I,MSG);
        FW=DDSC$FW[PT]; 
        IC=DDSC$IC[PT];              # INCREMENTOR #
  
# 
*     IF BIT LENGTH *BL* IS ZERO, THE VALUE IS A FULL WORD VALUE. 
*     THE VALUE IS PRINTED IN FIVE 12-BIT BYTES, IN SUCCESSIVE ROWS.
# 
  
        IF (BL EQ 0)                 # NO BIT LENGTH #
        THEN
          BEGIN  # ACCESS FULL WORD # 
          WRITEV(MSG,CHRC,1,LN,LFDC); 
          FASTFOR J=1 STEP 1 UNTIL DDSC$LN[PT]
          DO
            BEGIN  # PROCESS ONE ENTRY #
            IF (ST NQ NSBC)          # SUBTITLE PRESENT # 
            THEN                     # PRINT SUBTITLE # 
              BEGIN 
              MSG=SMGT$TX[ST+J-1];
              WRITEV(MSG,CHRC,10,10,NLFC);
              END 
  
            FASTFOR L=0 STEP 1 UNTIL 4
            DO
              BEGIN  # BREAK A WORD INTO FIVE BYTES # 
              N=31; 
              SLOWFOR K=1 STEP 1 UNTIL NIPP 
              DO                     # PRINT BYTE L OF COLUMN K # 
                BEGIN 
                VL=C<L*2,2>DCDT$CW[(K-1)*DCDL + FW];
                WRITEV(VL,OC3C,N,4,NLFC); 
                N=N+10; 
                END 
  
              WRITEV(BLKC,CHRC,N+2,1,LFDC);  # LINE FEED #
              END  # BREAK A WORD INTO FIVE BYTES # 
  
            FW=FW+IC; 
            END  # PROCESS ONE ENTRY #
  
          END  # ACCESS FULL WORD # 
  
# 
*     IF BIT LENGTH *BL* IS NON ZERO, THE VALUE IS A PARTIAL WORD 
*     VALUE. *WC* IS THE WORD COUNT INDICATING WHAT WORD IN A 
*     MULTIPLE-ENTRY ELEMENT THAT CONTAINS THE VALUE. IF THE ELEMENT
*     IS A SINGLE-ENTRY ELEMENT, *WC* IS ZERO. *BL* AND *BT* ARE
*     THE NUMBER OF BITS AND THE STARTING BIT POSITION, RESPECTIVELY. 
# 
  
        ELSE
          BEGIN  # ACCESS PARTIAL WORD #
          WRITEV(MSG,CHRC,1,LN,NLFC); 
          BT=DSPT$BT[I]/BPCC;        # CHARACTER POSITION # 
          WC=DSPT$WC[I];             # WORD POSITION #
          BL=BL/BPCC;                # NUMBER OF CHARACTERS # 
          N=BCLC + 2; 
  
          SLOWFOR J=1 STEP 1 UNTIL NIPP 
          DO
            BEGIN 
            VL=C<BT,BL>DCDT$CW[(J-1)*DCDL + FW + WC]; 
            WRITEV(VL,INTC,N,8,NLFC); 
            N=N+10; 
            END 
  
          WRITEV(BLKC,CHRC,N+2,1,LFDC);  # LINE FEED #
          END  # ACCESS PARTIAL WORD #
  
        END  # FOLLOW TABLE *DSPT* #
  
      RETURN; 
      END  # PUTSNS # 
  
      TERM
PROC READRC(STAT);
# TITLE READRC - READ DATA FILE.  # 
  
      BEGIN  # READRC # 
  
# 
**    READRC - READ DATA FILE.
* 
*     READ ONE RECORD FROM THE DATA FILE. 
* 
*     PROC READRC(STAT) 
* 
*     ENTRY      THE DATA FILE. 
* 
*     EXIT       STAT = STATUS CODE.
*                ONE RECORD OF THE DATA FILE IS READ TO 
*                WORKING STORAGE AREA *WSAI*. 
*                THE NUMBER OF WORDS READ *IBNW* IS UPDATED.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM STAT       I;             # STATUS CODE #
  
# 
****  PROC READRC - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC READSKP;                # READ AND SKIP #
        END 
  
# 
****  PROC READRC - XREF LIST END.
# 
  
      DEF RFETL      #8#;            # FET LENGTH # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMAFET 
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ARRAY STT [0:0] P(1);          # STATUS CODE #
        BEGIN  # ARRAY STT #
        ITEM STT$STAT   U(00,42,18);  # STATUS #
        ITEM STT$LN     U(00,42,04);  # LEVEL NUMBER #
        ITEM STT$AT     U(00,46,04);  # ABNORMAL TERMINATION CODE # 
        ITEM STT$CODE   U(00,50,10);  # REQUEST/RETURN CODE # 
        END  # ARRAY STT #
  
  
  
  
# 
*     BEGIN READRC PROC.
# 
  
      P<FETSET>=LOC(FETI);
      FET$IN[0]=FET$FRST[0];         # SET *IN* = *FIRST* # 
      FET$OUT[0]=FET$FRST[0];        # SET *OUT* = *FIRST* #
      READSKP(FETSET,0,1);
      IBNW = FET$IN[0] - FET$OUT[0];  # NUMBER OF WORDS READ #
      STT$LN[0]=FET$LN[0];
      STT$AT[0]=FET$AT[0];
      STT$CODE[0]=FET$CODE[0];
  
      STAT=STT$STAT[0]; 
      RETURN; 
      END  # READRC # 
  
      TERM
PROC REPTLE;
# TITLE REPTLE - PRINT REPORT SUBTITLE.  #
  
      BEGIN  # REPTLE # 
  
# 
**    REPTLE - PRINT REPORT SUBTITLE. 
* 
*     *REPTLE* PRINTS THE SUBTITLE AT EACH PAGE EJECT.
*     THE SUBTITLE TO BE PRINTED DEPENDS ON THE VALUE 
*     OF *TLFG* (COMMON BLOCK *CIOCOMM*). 
* 
*     PROC REPTLE 
* 
*     ENTRY      NIPP = NUMBER OF INTERVALS PER PAGE
*                       (COMMON BLOCK *CIOCOMM*). 
*                TLFG = SUBTITLE FLAG (COMMON BLOCK *CIOCOMM*). 
*                       IF *TLFG* IS :  
*                       0    NO SUBTITLE. 
*                       1    PRINT SUBTITLE FOR DATA BLOCK. 
*                       2    PRINT SUBTITLE FOR SNAPSHOT. 
*                       3    PRINT SUBTITLE FOR EST REPORT. 
* 
*     EXIT       SUBTITLE IS PRINTED ON TOP OF EACH PAGE. 
# 
  
# 
****  PROC REPTLE - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        FUNC EDATE C(10);            # CONVERT NUMBER TO DATE # 
        FUNC ETIME C(10);            # CONVERT NUMBER TO TIME # 
        PROC RPLINEX;                # PRINT ONE LINE # 
        FUNC XCDD C(10);             # CONVERT TO DISPLAY DECIMAL # 
        END 
  
# 
****  PROC REPTLE - XREF LIST END.
# 
  
      DEF ASTC       #"*"#;          # ASTERISK # 
      DEF BLKC       #" "#;          # BLANK #
      DEF PRDC       #"."#;          # PERIOD # 
      DEF SLSC       #"/"#;          # SLASH #
      DEF ZERC       #"0"#;          # CHARACTER ZERO # 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM ESTFS      B=TRUE;        # FIRST EST SUBTITLE FLAG #
      ITEM HRS        I;             # HOUR # 
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM J          I;             # TEMPORARY VARIABLE # 
      ITEM MNS        I;             # MINUTE # 
      ITEM MSG        C(40);         # TEMPORARY STORAGE #
      ITEM N          I;             # TEMPORARY VARIABLE # 
      ITEM N1         I;             # TEMPORARY VARIABLE # 
      ITEM N2         I;             # TEMPORARY VARIABLE # 
      ITEM OF         I;             # OFFSET # 
  
      ARRAY T [0:0] P(1);            # TEMPORARY STORAGE #
        BEGIN 
        ITEM T$WD       C(00,00,10);  # TEN CHARACTER WORD #
        ITEM T$3C       C(00,00,03);  # THREE CHARACTER ITEM #
        ITEM T$2C       C(00,00,02);  # TWO CHARACTER ITEM #
        ITEM T$1C       C(00,00,01);  # ONE CHARACTER ITEM #
        ITEM T$ZC       C(00,06,01);  # ZERO FILL # 
        END 
  
      ARRAY TEM [0:0] P(1);          # TEMPORARY STORAGE #
        BEGIN  # ARRAY TEM #
        ITEM TEM$WD     C(00,00,10);  # TEN CHARACTER ITEM #
        ITEM TEM$3C     C(00,42,03);  # THREE CHARACTER ITEM #
        ITEM TEM$2C     C(00,48,02);  # TWO CHARACTER ITEM #
        END 
  
  
  
  
  
  
# 
*     BEGIN REPTLE PROC.
# 
  
      IF (TLFG EQ 0) OR (P$L EQ NULL)   # NO TITLE OR NO REPORT FILE #
      THEN
        BEGIN 
        RETURN;                      # NO SUBTITLE #
        END 
  
      IF (TLFG EQ 3)                 # PRINTING EST # 
      THEN
        BEGIN  # PRINT EST SUBTITLE # 
        RPLINEX(OFFA,BLKC,1,1,LFDC);
        RPLINEX(OFFA,BLKC,1,1,LFDC);
        IF (ESTFS)                   # FIRST EST SUBTITLE # 
        THEN
          BEGIN 
          MSG="EQUIPMENT STATUS TABLE"; 
          RPLINEX(OFFA,MSG,5,22,LFDC);
          ESTFS=FALSE;
          END 
  
        ELSE                         # SECOND EST SUBTITLE #
          BEGIN 
          MSG="EQUIPMENT STATUS TABLE  (CONTINUED)";
          RPLINEX(OFFA,MSG,5,35,LFDC);
          END 
  
        MSG="NO.  TYPE  STAT  EQ  UN  CHANNELS";
        RPLINEX(OFFA,MSG,5,33,NLFC);
        MSG="EST ENTRY";
        RPLINEX(OFFA,MSG,42,9,NLFC);
        MSG="TRACK       FILES";
        RPLINEX(OFFA,MSG,86,17,LFDC); 
        RPLINEX(OFFA,BLKC,1,1,LFDC);
        RETURN; 
        END  # PRINT EST SUBTITLE # 
  
      P<DCDT>=LOC(DBUF[DCHL]);
      P<DDSM>=LOC(DBUF[DCHL + DCDC*DCDL*2]);
      P<DDSC>=LOC(DDDT);
  
# 
*     PRINT INTERVAL TIMES. 
# 
  
      RPLINEX(OFFA,BLKC,1,1,LFDC);   # LINE FEED #
      IF(P$IN NQ 0) 
      THEN
        BEGIN 
        TEM$WD=XCDD(P$IN);
        END 
  
      ELSE
        BEGIN 
        TEM$WD=XCDD(P$IC);
        END 
  
      T$3C[0]=TEM$3C[0];
      RPLINEX(OFFA,T,1,3,NLFC); 
      IF (P$IN NQ 0)                 # INTERVAL TIME SPECIFIED #
      THEN
        BEGIN 
        RPLINEX(OFFA," MINS INTERVAL ",5,14,NLFC);
        END 
  
      ELSE
        BEGIN 
        RPLINEX(OFFA," RECS INTERVAL ",5,14,NLFC);
        END 
  
      J = BCLC + 1; 
      OF=DCDC*DCDL + DDSC$FW[PDTM]; 
  
      SLOWFOR I=1 STEP 1 UNTIL NIPP 
      DO
        BEGIN  # PRINT INTERVAL TIME #
        N=DCDT$ET[(I-1)*DCDL + OF];  # INTERVAL END TIME #
        T$WD[0]=ETIME(N);            # CONVERT TO DISPLAY TIME #
        RPLINEX(OFFA,T,J,9,NLFC); 
        J=J+10; 
        END  # PRINT INTERVAL TIME #
  
# 
*     PRINT TITLES OF SUBTOTAL AND TOTAL. IF SNAPSHOT 
*     LOOP IS BEING PRINTED, THESE TITLES WILL NOT BE 
*     PRINTED.
# 
  
      IF (TLFG EQ 1)                 # NOT PRINTING SNAPSHOT ELEMENTS # 
      THEN
        BEGIN  # PRINT TIME # 
  
# 
*     PRINT SUBTOTAL HEADER. SUBTOTAL IS NOT PRINTED IF THE SUBTOTAL
*     AND THE TOTAL COLUMNS ARE THE SAME, I.E. IF THE TOTAL COLUMNS 
*     PRINTED *TCOL* IS LESS THAN 7 COLUMNS. THE SUBTOTAL HEADER IS 
*     NOT PRINTED IF THE CURRENT PAGE IS USED TO PRINT THE TOTAL
*     STATISTICS ONLY (*NIPP* IS 0).
# 
  
        IF (NIPP GR 0) AND (TCOL GR (DCDC-3)) 
        THEN
          BEGIN  # COMPUTE AND PRINT LENGTH OF SUBTOTAL # 
          N=P$IN*NIPP;               # LENGTH OF SUBTOTAL # 
          HRS=N/60;                  # NUMBER OF HOURS #
          MNS=N - (HRS*60);          # NUMBER OF MINUTES #
          TEM$WD=XCDD(HRS); 
          T$3C[0]=TEM$3C[0];
          IF (T$2C[0] EQ BLKC)
          THEN
            BEGIN 
            T$ZC[0]=ZERC; 
            END 
  
          RPLINEX(OFFA,T,J,3,NLFC); 
          RPLINEX(OFFA,":",J+3,1,NLFC); 
          TEM$WD=XCDD(MNS); 
          T$2C[0]=TEM$2C[0];
          IF (T$1C[0] EQ BLKC)
          THEN
            BEGIN 
            T$1C[0]=ZERC; 
            END 
  
          RPLINEX(OFFA,T,J+4,2,NLFC); 
          END  # COMPUTE AND PRINT LENGTH OF SUBTOTAL # 
  
# 
*     PRINT TOTAL HEADER. TOTAL HEADER IS NOT PRINTED IF MORE 
*     THAN 7 COLUMNS ARE PRINTED ON THE CURRENT PAGE. 
# 
  
        IF (NIPP GR (DCDC-3)) 
        THEN
          BEGIN 
          RPLINEX(OFFA," HR",J+6,3,LFDC); 
          END 
  
        ELSE
          BEGIN  # COMPUTE AND PRINT LENGTH OF TOTAL #
          IF (NIPP GR 0) AND (TCOL GR (DCDC-3)) 
          THEN
            BEGIN 
            RPLINEX(OFFA," HR",J+6,3,NLFC); 
            J=J+10; 
            END 
  
          P<DCHD>=LOC(DBUF);
          P<DDSC>=LOC(DDHD);
          N=(DCHD$WD[DDSC$FW[DLFW]]*ACNS)/60;  # TOTAL MINUTES #
          HRS=N/60;                  # TOTAL HOURS #
          MNS=N - (HRS*60); 
          TEM$WD[0]=XCDD(HRS);
          T$3C[0]=TEM$3C[0];
          IF (T$2C[0] EQ BLKC)
          THEN
            BEGIN 
            T$ZC[0]=ZERC; 
            END 
  
          RPLINEX(OFFA,T,J,3,NLFC); 
          RPLINEX(OFFA,":",J+3,1,NLFC); 
          TEM$WD[0]=XCDD(MNS);
          T$2C[0]=TEM$2C[0];
          IF (T$1C[0] EQ BLKC)
          THEN
            BEGIN 
            T$1C[0]=ZERC; 
            END 
  
          RPLINEX(OFFA,T,J+4,2,NLFC); 
          RPLINEX(OFFA," HR",J+6,3,NLFC); 
  
# 
*     PRINT HEADERS FOR THE MAXIMUM AND MINIMUM STATISTIC COLUMNS.
# 
  
          P<DDSC>=LOC(DDDT);
          N1=DDSM$BT[DDSC$FW[PDTM]];   # TOTAL BEGIN TIME # 
          N2=DDSM$ET[DDSC$FW[PDTM]];   # TOTAL END TIME # 
          T$WD[0]=EDATE(N1/SHFC);    # CONVERT TO DATE #
          RPLINEX(OFFA,T,J+11,9,NLFC);
          RPLINEX(OFFA,"TO ",J+21,3,NLFC);
          T$WD[0]=EDATE(N2/SHFC); 
          RPLINEX(OFFA,T,J+23,9,LFDC);
          END  # COMPUTE AND PRINT LENGTH OF TOTAL #
  
        END  # PRINT TIME # 
  
      ELSE                           # PRINTING SNAPSHOT ELEMENTS # 
        BEGIN 
        RPLINEX(OFFA,BLKC,J,1,LFDC);
        END 
  
# 
*     PRINT SECOND LINE OF THE SUBTITLE.
# 
  
      J=BCLC + 1; 
      SLOWFOR I=1 STEP 1 UNTIL NIPP 
      DO
        BEGIN 
        RPLINEX(OFFA," INTERVAL",J,9,NLFC); 
        J=J+10; 
        END 
  
      IF (TLFG EQ 1)                 # NOT PRINTING SNAPSHOT ELEMENTS # 
      THEN
        BEGIN  # PRINT SUBTOTAL AND TOTAL HEADERS # 
        IF (NIPP GR (DCDC-3)) 
        THEN                         # PRINT TOTAL ON NEXT PAGE # 
          BEGIN 
          RPLINEX(OFFA," SUBTOTAL",J,9,LFDC); 
          END 
  
        ELSE                         # PRINT TOTAL ON THE SAME PAGE # 
          BEGIN  # PRINT SUBTOTAL AND TOTAL HEADERS ON SAME PAGE #
          IF (NIPP GR 0)             # TOTAL IS NOT FIRST COLUMN #
            AND (TCOL GR (DCDC-3))
          THEN
            BEGIN 
            RPLINEX(OFFA," SUBTOTAL",J,9,NLFC); 
            J=J+10; 
            END 
  
          RPLINEX(OFFA,"    TOTAL",J,9,NLFC); 
          RPLINEX(OFFA,"    *MAX* ",J+10,10,NLFC);
          RPLINEX(OFFA,"    *MIN* ",J+20,10,LFDC);
          END  # PRINT SUBTOTAL AND TOTAL HEADERS ON SAME PAGE #
  
        END  # PRINT SUBTOTAL AND TOTAL HEADERS # 
  
      ELSE                           # PRINTING SNAPSHOT ELEMENTS # 
        BEGIN 
        RPLINEX(OFFA,BLKC,J,1,LFDC);
        END 
  
      RPLINEX(OFFA,BLKC,1,1,LFDC);   # LINE FEED #
      RETURN; 
      END  # REPTLE # 
  
      TERM
PROC WRITEV(PVL,(DTY),(BCL),(FWD),(CRC)); 
# TITLE WRITEV - WRITE TO REPORT FILE.  # 
  
      BEGIN  # WRITEV # 
  
# 
**    WRITEV - WRITE TO REPORT FILE.
* 
*     WRITE ONE VALUE TO THE REPORT FILE. 
* 
*     PROC WRITEV(PVL,(DTY),(BCL),(FWD),(CRC))
* 
*     ENTRY      PVL = VALUE TO BE PRINTED. 
*                DTY = DATA TYPE. 
*                BCL = BEGINNING COLUMN TO WRITE. 
*                FWD = FIELD WIDTH. 
*                CRC = CARRIAGE CONTROL.
*                      *LFD* IF LINE FEED AT THE END OF THE LINE
*                      *NLF* IF NO LINE FEED
* 
*     EXIT       THE VALUE IS PRINTED TO THE REPORT FILE ACCORDING
*                TO THE SPECIFIED FORMAT. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM PVL        U;             # ADDRESS OF VALUE # 
      ITEM DTY        I;             # DATA TYPE #
      ITEM BCL        I;             # BEGINNING COLUMN # 
      ITEM FWD        I;             # FIELD WIDTH #
      ITEM CRC        I;             # CARRIAGE CONTROL # 
  
# 
****  PROC WRITEV - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK/ZERO FILL ITEM # 
        PROC RPLINE;                 # PRINT ONE REPORT LINE #
        FUNC XCDD C(10);             # BINARY TO DISPLAY DECIMAL #
        FUNC XCED C(10);             # BINARY TO DISPLAY *E* FORMAT # 
        FUNC XCFD C(10);             # BINARY TO DISPLAY REAL # 
        FUNC XCOD C(10);             # BINARY TO DISPLAY OCTAL #
        END 
  
# 
****  PROC WRITEV - XREF LIST END.
# 
  
      DEF BLKC       #" "#;          # BLANK #
      DEF MAXF       #1.0E4#;        # MAXIMUM VALUE OF *F* FORMAT #
      DEF ZERC       #"0"#;          # CHARACTER 0 #
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
*CALL     COMABZF 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM N          I;             # TEMPORARY VARIABLE # 
      ITEM NF         R;             # TEMPORARY VARIABLE # 
      ITEM T1         I;             # TEMPORARY VARIABLE # 
      ITEM T2         I;             # TEMPORARY VARIABLE # 
  
      ARRAY P [0:0] P(1);            # TEMPORARY BUFFER # 
        BEGIN  # ARRAY P #
        ITEM P$WD       C(00,00,10);  # 10 CHAR VALUE # 
        ITEM P$WF       C(00,06,09);  # 9 LEAST SIGNIFICANT DIGITS #
        END  # ARRAY P #
  
      ARRAY TEM [0:0] P(1);          # DISPLAY CODE VALUE # 
        BEGIN  # ARRAY TEM #
        ITEM T$WD       C(00,00,10);  # VALUE # 
        ITEM T$W1       C(00,00,09);  # VALUE WITH NO POSTFIX # 
        ITEM T$W2       C(00,54,01);  # *B* POSTFIX # 
        END  # ARRAY TEM #
  
      BASED 
      ARRAY VAL [0:0] P(1);          # VALUE  TO BE PRINTED # 
        BEGIN  # ARRAY VAL #
        ITEM VAL$C      C(00,00,50);  # CHARACTER TYPE #
        ITEM VAL$N      I(00,00,60);  # INTEGER TYPE #
        ITEM VAL$F      R(00,00,60);  # REAL TYPE # 
        END  # ARRAY VAL #
  
      SWITCH TYPE 
             CHRS,                   # CHARACTER #
             FLPS,                   # FLOATING POINT # 
             INTS,                   # INTEGER #
             OC1S,                   # OCTAL WITH *B* POSTFIX # 
             OC2S,                   # OCTAL WITH NO POSTFIX #
             OC3S,                   # *B* POSTFIX, ZERO FILLED # 
             OC4S,                   # OCTAL, ALLOWING FOR *UESC* # 
             ;                       # END OF TYPE #
  
      LABEL  EXIT;                   # END CASE # 
  
  
  
  
  
# 
*     BEGIN WRITEV PROC.
# 
  
      IF (P$L EQ NULL)               # NO REPORT FILE # 
      THEN  # SUPPRESS REPORT FILE #
        BEGIN 
        RETURN; 
        END 
  
      P<VAL>=LOC(PVL);
      GOTO TYPE[DTY]; 
  
CHRS:                                # CHARACTER #
      BZFILL(VAL,TYPFILL"BFILL",FWD); 
      RPLINE(OFFA,C<0,FWD>VAL$C[0],BCL,FWD,CRC);
      RETURN; 
  
FLPS:                                # FLOATING POINT # 
      IF (VAL$F[0] GQ MAXF)          # PRINT IN *E* FORMAT #
      THEN
        BEGIN 
        NF=VAL$F[0];
        T$WD[0]=XCED(NF); 
        END 
  
      ELSE                           # PRINT IN *F* FORMAT #
        BEGIN 
        N=VAL$F[0]*1000.0 + 0.5;
        T$WD[0]=XCFD(N);
        END 
  
      GOTO EXIT;
  
INTS:                                # INTEGER #
      T$WD[0]=XCDD(VAL$N[0]); 
      GOTO EXIT;
  
OC1S:                                # OCTAL POSTFIXED WITH *B* # 
      P$WD[0]=XCOD(VAL$N[0]); 
      T$W1[0]=P$WF[0];
      T$W2[0]="B";
      GOTO EXIT;
  
OC2S:                                # OCTAL WITHOUT *B* POSTFIX #
      T$WD[0]=XCOD(VAL$N[0]); 
      GOTO EXIT;
  
OC3S:                                # OCTAL NO POSTFIX, ZERO FILLED #
      T$WD[0]=XCOD(VAL$N[0]); 
      SLOWFOR N=0 STEP 1 WHILE C<N,1>T$WD[0] EQ BLKC
      DO   #  CONVERT BLANK TO DISPLAY 0 #
        BEGIN 
        C<N,1>T$WD[0]=ZERC; 
        END 
      GOTO EXIT;
  
OC4S:                                # OCTAL WITH *B*, SHIFTED *UESC* # 
      T1 = P<DCHD>; 
      T2 = P<DDSC>; 
      P<DCHD> = LOC(DBUF);
      P<DDSC> = LOC(DDHD);
      P$WD[0]=XCOD(VAL$N[0]*2**DCHD$WD[DDSC$FW[UESC]]); 
      P<DCHD> = T1; 
      P<DDSC> = T2; 
      T$W1[0]=P$WF[0];
      T$W2[0]="B";
  
EXIT: 
      RPLINE(OFFA,C<10-FWD,FWD>T$WD[0],BCL,FWD,CRC);
      RETURN; 
      END  # WRITEV # 
  
      TERM
PROC WRTSUM((NIP)); 
# TITLE WRTSUM - WRITE SUMMARY FILE.  # 
  
      BEGIN  # WRTSUM # 
  
# 
**    WRTSUM - WRITE SUMMARY FILE.
* 
*     WRITE DATA BLOCK ELEMENTS TO SUMMARY FILE.
* 
*     PROC WRTSUM((NIP))
* 
*     ENTRY      TABLE *DCDT*.
*                NIP = NUMBER OF INTERVALS PER PAGE.
* 
*     EXIT       THE AVERAGE AND STANDARD DEVIATION OF EACH 
*                DATA BLOCK ELEMENT ARE WRITTEN TO THE SUMMARY
*                FILE.
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM NIP        I;             # NUMBER OF INTERVALS PER PAGE # 
  
# 
****  PROC WRTSUM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC WRITER;                 # WRITE EOR #
        PROC WRITEW;                 # *CIO* WRITEW # 
        END 
  
# 
****  PROC WRTSUM - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL     COMUCPD 
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM WA         I;             # ADDRESS OF DECODED BUFFER #
  
      BASED 
      ARRAY SUM [0:0] P(1);;         # DUMMY BUFFER # 
  
  
  
  
  
# 
*     BEGIN WRTSUM PROC.
# 
  
      P<DCDT>=LOC(DBUF[DCHL]);
      WA=1; 
      SLOWFOR I=1 STEP 1 UNTIL NIP
      DO
        BEGIN 
        P<SUM>=LOC(DCDT$WD[WA]);
        WRITEW(FETS,SUM,DCDL,0);     # WRITE AVERAGE #
        P<SUM>=LOC(DCDT$WD[DCDC*DCDL + WA]);
        WRITEW(FETS,SUM,DCDL,0);     # WRITE STANDARD DEVIATION # 
        WRITER(FETS,1);              # WRITE EOR #
        WA=WA + DCDL; 
        END 
  
      RETURN; 
      END  # WRTSUM # 
  
      TERM
FUNC XCED((NUM)) C(10); 
# TITLE XCED - CONVERT NUMBER TO THE DISPLAY *E* FORMAT.  # 
  
      BEGIN  # XCED # 
  
# 
**    XCED - CONVERT NUMBER TO THE DISPLAY *E* FORMAT.
* 
*     *XCED* CONVERTS A REAL NUMBER TO THE FORTRAN *E* FORMAT.
*     THE NUMBER HAS TO BE GREATER THAN 1.0E4 AND LESS THAN 
*     (2**32 - 1).
*     THE RESULT IS A NORMALIZED NUMBER IN DISPLAY CODE.
*     THE FORMAT OF THE CONVERTED NUMBER IS : 
* 
*     BB.XXXXEYY
* 
*     THE VALUE IS RIGHT-JUSTIFIED, BLANK FILLED. 
*     IF THE EXPONENT *YY* IS ONLY ONE DIGIT LONG,
*     THE MANTISSA *XXXX* IS INCREASED TO FIVE DIGITS.
* 
*     FUNC XCED((NUM)) C(10)
* 
*     ENTRY     NUM = NUMBER TO BE CONVERTED. 
* 
*     EXIT      THE NUMBER IS NORMALIZED AND CONVERTED TO 
*               DISPLAY CODE. 
# 
  
# 
*     PARAMETER LIST. 
# 
  
      ITEM NUM        R;             # NUMBER TO BE CONVERTED # 
  
# 
****  FUNC XCED - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        FUNC XCDD C(10);             # BINARY TO DISPLAY DECIMAL #
        END 
  
# 
****  FUNC XCED - XREF LIST END.
# 
  
      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING # 
  
*CALL      COMUCPD
  
# 
*     LOCAL VARIABLES.
# 
  
      ITEM EXP        I;             # EXPONENT # 
      ITEM I          I;             # FOR LOOP CONTROL # 
      ITEM J          I;             # FOR LOOP CONTROL # 
      ITEM NUMF       R;             # TEMPORARY VARIABLE # 
      ITEM NUMI       I;             # TEMPORARY VARIABLE # 
      ITEM P          I;             # POSITION OF *E* #
      ITEM TEM1       C(10);         # TEMPORARY VARIABLE # 
  
      ARRAY TEM [0:0] P(1);          # TEMPORARY STORAGE #
        BEGIN  # ARRAY TEM #
        ITEM T$WD       C(00,00,10);  # CONVERTED NUMBER #
        ITEM T$DP       C(00,12,01);  # DECIMAL POINT # 
        END  # ARRAY TEM #
  
  
  
  
  
# 
*     BEGIN XCED FUNC.
# 
  
      NUMF=NUM; 
      EXP=0;
  
# 
*     NORMALIZE THE NUMBER. 
# 
  
      SLOWFOR I=1 WHILE (NUMF GQ 1.0) 
      DO
        BEGIN 
        NUMF=NUMF/10.0; 
        EXP=EXP + 1;
        END 
  
      T$WD[0]=XCDD(EXP);
      T$DP[0]=".";                   # DECIMAL POINT #
      P=8;                           # POSITION OF *E* #
      IF (EXP GQ 10)
      THEN
        BEGIN 
        P=7;
        END 
  
      NUMI=NUM; 
      TEM1=XCDD(NUMI);
  
# 
*     MOVE THE MOST SIGNIFICANT DIGITS TO *TEM*.
# 
  
      SLOWFOR I=0 STEP 1 WHILE (C<I,1>TEM1 EQ " ")
      DO;                            # FIND THE FIRST DIGIT # 
  
      FASTFOR J=3 STEP 1 UNTIL P-1
      DO
         BEGIN  # MOVE THE MOST SIGNIFICANT DIGITS #
         C<J,1>T$WD[0]=C<I,1>TEM1;
         I=I+1; 
         END  # MOVE THE MOST SIGNIFICANT DIGITS #
  
      C<P,1>T$WD[0]="E";             # PLACE THE *E* CHARACTER #
      XCED=T$WD[0]; 
      RETURN; 
      END  # XCED # 
  
      TERM
