SXHLR 
PROC HLRQENQ(ADDR); 
  
# TITLE HLRQENQ - HIGH LEVEL REQUEST QUEUE ENQUEUER.                  # 
  
      BEGIN  # HLRQENQ #
  
# 
**    HLRQENQ - HIGH LEVEL REQUEST QUEUE ENQUEUER.
* 
*     *HLRQENQ* INSERTS AN ENTRY INTO THE HIGH LEVEL REQUEST QUEUE
*     (HLRQ) BY LINKING THE ENTRY INTO AN *HLRQ* READY CHAIN. *HLRQENQ* 
*     IS CALLED ONLY IF THE *HLRQ* IS NOT FULL. 
* 
*     PROC       HLRQENQ(ADDR)
* 
*     EXIT       (ADDR)   - ADDRESS OF ENTRY ADDED TO QUEUE.
* 
*     MESSAGES   * EXEC ABNORMAL, HLRQENQ.*.
# 
  
  
      ITEM ADDR       U;             # ADDRESS OF *HLRQ* ENTRY #
  
# 
****  PROC HLRQENQ - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABORT #
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC MESSAGE;                # ISSUE MESSAGE #
        END 
  
# 
****
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBCHN 
*CALL COMXHLR 
*CALL COMXMSC 
  
  
  
  
# 
*     CHECK FOR *HLRQ* FULL.
# 
  
      ADDR = CHN$BOC[LCHN"HL$FRSPC"]; 
  
      IF ADDR EQ 0                   # IF NO FREE ENTRIES # 
      THEN
        BEGIN 
        FE$RTN[0] = "HLRQENQ."; 
        MESSAGE(FEMSG,UDFL1); 
        ABORT;
        END 
  
      DEL$LNK(ADDR,LCHN"HL$FRSPC",0);  # DELETE ENTRY FROM FREE SPACE 
                                         CHAIN #
      P<HLRQ> = ADDR; 
      HLR$HPS[0] = PROCST"INITIAL"; 
      ADD$LNK(ADDR,LCHN"HL$READY",0);  # ADD ENTRY TO READY CHAIN # 
      ADD$LNK(ADDR,LCHN"HL$ACTV",1);  # ADD ENTRY TO ACTIVE CHAIN # 
  
  
      RETURN; 
  
      END  # HLRQENQ #
  
    TERM
PROC HLRQMTR; 
  
# TITLE HLRQMTR - HIGH LEVEL REQUEST QUEUE MONITOR.                   # 
  
      BEGIN  # HLRQMTR #
  
# 
**    HLRQMTR - HIGH LEVEL REQUEST QUEUE MONITOR. 
* 
*     THE HIGH LEVEL REQUEST QUEUE MONITOR CONTROLS THE ACTIVATION
*     OF *HLRQ* PROCESSORS.  EACH *HLRQ* ENTRY ON THE READY CHAIN IS
*     ACTIVATED BY CALLING THE APPROPRIATE PROCESSOR. 
* 
*     PROC HLRQMTR. 
* 
*     EXIT       IF THE PROCESS STATE FIELD OF AN *HLRQ* ENTRY IS SET 
*                TO "COMPLETE" AFTER ITS PROCESSOR IS CALLED, THE ENTRY 
*                IS CLEARED AND LINKED INTO THE FREE SPACE CHAIN. 
*                OTHERWISE, THE PROCESSOR HAS SET UP SOME CONDITION 
*                THAT WILL EVENTUALLY CAUSE THE *HLRQ* ENTRY TO BE
*                RELINKED INTO THE *HLRQ* READY CHAIN.
* 
*     NOTES      *HLRQMTR* IS TO BE CALLED ONLY IF THE *HLRQ* 
*                READY CHAIN IS POPULATED.
# 
  
# 
****  PROC HLRQMTR - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC DESTAGR;                # DESTAGE A FILE # 
        PROC STAGER;                 # STAGE A FILE # 
        PROC ZFILL;                  # ZERO FILL BUFFER # 
        END 
  
# 
****  PROC HLRQMTR - XREF LIST END. 
# 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBCHN 
*CALL COMXCTF 
*CALL COMXHLR 
*CALL COMXMSC 
  
      ITEM FLNM       C(7);          # FILE NAME #
      ITEM HLRENT     U;             # *HLRQ* ENTRY ADDRESS # 
  
  
      ITEM ACTIVE     I;             # NUMBER OF TIMES HLRQ LOOPED #
      ITEM PFMFIRST   B;             # *UGET/UREPLACE* ACTIVE # 
  
      SWITCH HLPROC:HLRPN            # *HLRQ* PROCESSOR CALLS # 
                HL1:STAGE,           # PROCESSOR 1 #
                HL2:DESTAGE,         # PROCESSOR 2 #
             ENDHLP:ENDPN;           # END *HLRQ* PROCESSOR CALLS # 
                                               CONTROL EJECT; 
  
# 
*     TRAVERSE THE *HLRQ* READY CHAIN.
# 
      IF CHN$BOC[LCHN"HL$PFMWAIT"] NQ 0 
      THEN      # UGET OR UREPLACE COMPLETED #
        BEGIN 
        HLRENT = CHN$BOC[LCHN"HL$PFMWAIT"]; 
        DEL$LNK(HLRENT,LCHN"HL$PFMWAIT",0); 
        ADD$LNK(HLRENT,LCHN"HL$READY",0); 
        PFMFIRST = TRUE;
        END 
  
      ACTIVE = 0; 
  
      FASTFOR DUMMY = 0 WHILE CHN$BOC[LCHN"HL$READY"] NQ 0
        AND ACTIVE LQ 20
        AND NOT GLPFMFL 
      DO
        BEGIN  # TRAVERSE *HLRQ* READY CHAIN #
        ACTIVE = ACTIVE + 1;
        IF PFMFIRST 
        THEN
          BEGIN     # TAKE CURRENT *HLRENT* # 
          PFMFIRST = FALSE; 
          END 
  
        ELSE
          BEGIN    # FIND NEW ADDRESS # 
          HLRENT = CHN$BOC[LCHN"HL$READY"]; 
          END 
        DEL$LNK(HLRENT,LCHN"HL$READY",0); 
        P<HLRQ> = HLRENT; 
  
        IF HLR$HPS[0] EQ PROCST"COMPLETE" 
        THEN
          BEGIN 
          GOTO ENDHLP;
          END 
  
# 
*     SIMULATED CASE STATEMENT FOR *HLRQ* PROCESSOR CALLS.
# 
  
        GOTO HLPROC[HLR$HPN[0]];
  
HL1:                                 # STAGE REQUEST #
        STAGER(HLRENT); 
        GOTO ENDHLP;
  
HL2:                                 # DESTAGE REQUEST #
        DESTAGR(HLRENT);
        GOTO ENDHLP;
  
  
  
ENDHLP: 
  
# 
*     END OF SIMULATED CASE STATEMENT FOR *HLRQ* PROCESSOR CALLS. 
# 
  
        P<HLRQ> = HLRENT; 
        IF HLR$HPS[0] EQ PROCST"COMPLETE" 
        THEN
          BEGIN  # PROCESS IS COMPLETE #
  
# 
*     CLEAR *HLRQ* ENTRY. 
# 
  
          DEL$LNK(HLRENT,LCHN"HL$ACTV",1);
          FLNM = HLR$FLNM[0];        # PRESERVE FILE NAME # 
          ZFILL(HLRQ,HLRQLEN);
          HLR$FLNM[0] = FLNM; 
          ADD$LNK(HLRENT,LCHN"HL$FRSPC",0); 
          STG$MSK = 0;
          IF CHN$BOC[LCHN"HL$DRDRESW"] NQ 0 
          THEN
            BEGIN 
            HLRENT = CHN$BOC[LCHN"HL$DRDRESW"]; 
            DEL$LNK(HLRENT,LCHN"HL$DRDRESW",0); 
            ADD$LNK(HLRENT,LCHN"HL$READY",0); 
            END 
  
          END  # PROCESS IS COMPLETE #
  
        END  # TRAVERSE *HLRQ* READY CHAIN #
  
      RETURN; 
  
      END  # HLRQMTR #
  
    TERM
PROC MSGAFDF(TYPE,FC,CODE,HLRQADR); 
  
# TITLE MSGAFDF - ISSUE STATUS MESSAGE TO ACCOUNT AND EXEC DAYFILE.   # 
  
      BEGIN  # MSGAFDF #
  
# 
**    MSGAFDF - ISSUE STATUS MESSAGE TO ACCOUNT AND EXEC-S DAYFILE. 
* 
*     *MSGAFDF* IS CALLED BY *STAGER*, *DESTAGR*, *HLLOAD*, AND 
*     *HLUNLD* TO ISSUE STATUS MESSAGES NOTING BEGIN OR END 
*     OF A STAGE OR DESTAGE OPERATION, OR INITIATION OF A CARTRIDGE 
*     LOAD/UNLOAD.  AN APPROPRIATE MESSAGE IS CONSTRUCTED AND ISSUED
*     TO EITHER OR BOTH THE ACCOUNT AND JOB DAYFILE DEPENDING ON THE
*     CONTROLLING BIT MASKS AND THE *TM* RUN-TIME PARAMETER.
* 
*     PROC MSGAFDF(TYPE,FC,CODE,HLRQADR)
* 
*     ENTRY     (TYPE)    = MESSAGE TYPE.  "I", "B", "E", OR "S". 
*               (FC)      = CODE FOR THE FUNCTION BEING PERFORMED.
*                          "LD", "UL", "BS", "ES", "BD", "ED".
*D250 
*                       FC = *FC*   LD/UL/BS/ES/BD/ED.
*               (CODE)    = COMPLETION STATUS OF A STAGE OR DESTAGE.
*               (HLRQADR) = ADDRESS OF *HLRQ* ENTRY.
* 
*     EXIT      THE APPROPRIATE MESSAGE IS ISSUED.
* 
*     MESSAGES
*                T  FC  MESSAGE DETAIL. 
*                       T  = *TYPE* = B/E/I.
*                       FC = *FC*   = DS/LD/ST/UL.
* 
*                       MESSAGE DETAIL VARIES BY MESSAGE TYPE...
* 
*                 SMFC, SM=X, CSN=CCCCCCCC, ID=ZZ.
* 
*                       CCCCCCCC = CARTRIDGE SERIAL NUMBER. 
*                       ZZ       = MANUFACTURES'S ID. 
* 
* 
*                 SMFC, PPPPPPP/UUUUUU/FFFFFFF. 
* 
*                 SMFC, PPPPPPP/UUUUUU/LLLLLL-WW. 
* 
*                       PPPPPPP = PERMANENT FILE NAME.
*                       UUUUUU  = USER INDEX (OCTAL). 
*                       FFFFFFF = FAMILY NAME.
*                       LLLLLL  = FILE LENGTH (DECIMAL).
*                       WW      = VALUE OF *CODE* (OCTAL).
# 
  
# 
****  PROC MSGAFDF - XREF LIST BEGIN. 
# 
  
      ITEM TYPE       C(1);          # MESSAGE TYPE # 
      ITEM FC         C(2);          # FUNCTION BEING DONE #
      ITEM CODE       U;             # COMPLETION STATUS #
      ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS # 
  
  
      XREF
        BEGIN 
        FUNC XCDD C(10);             # BINARY TO DISPLAY (DECIMAL) #
        FUNC XCOD C(10);             # BINARY TO DISPLAY (OCTAL) #
        PROC BZFILL;                 # BLANK FILL A MESSAGE # 
        PROC MESSAGE;                # ISSUE MESSAGE TO O/S # 
        END 
  
# 
****  PROC MSGAFDF - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBBZF 
*CALL,COMBLRQ 
*CALL,COMBTDM 
*CALL,COMXHLR 
*CALL,COMXJCA 
*CALL,COMXMSC 
  
  
      DEF SKELCART   #"SMFC, SM=X, CSN=CCCCCCCC, ID=ZZ." #; 
      DEF SKELFILE   #"SMFC, PPPPPPP/UUUUUU/FFFFFFF." #;
      DEF SKELTAG    #"-WW." #; 
  
      ITEM DOAF       U;             # CONTROL ACCOUNT FILE MESSAGE # 
      ITEM DODF       U;             # CONTROL DAYFILE MESSAGE #
      ITEM OFFSET     U;             # BIT POSITION # 
  
  
      ARRAY MSGS [0:0] S(4);
        BEGIN 
  
# 
*     BASIC MESSAGE FORMAT. 
# 
  
        ITEM MSGS$SKEL  C(00,00,38);  # TEXT #
        ITEM MSGS$SMA   C(00,00,02);  # *SM* #
        ITEM MSGS$FC    C(00,12,02);  # *FC* #
        ITEM MSGS$ZERO  U(03,48,12) = [0];  # TERMINATOR #
  
# 
*     DETAIL FOR TYPE = "I".
# 
  
        ITEM MSGS$SM    C(00,54,01);  # X # 
        ITEM MSGS$CSN   C(01,36,08);  # CCCCCCCC #
        ITEM MSGS$ID    C(02,54,02);  # ZZ #
  
# 
*     DETAIL FOR TYPE = "B" AND PART OF "E".
# 
  
        ITEM MSGS$PFN   C(00,36,07);  # PPPPPPPP #
        ITEM MSGS$UI    C(01,24,06);  # UUUUUU #
        ITEM MSGS$FAM   C(02,06,07);  # FFFFFFF # 
  
# 
*     REST OF DETAIL FOR "E" TYPE MESSAGES. 
# 
  
        ITEM MSGS$LEN   C(02,06,06);  # LLLLLL #
        ITEM MSGS$TAG   C(02,42,04);  # "-WW." #
        ITEM MSGS$CODE  C(02,48,02);  # WW #
        END 
  
                                               CONTROL EJECT; 
      IF TYPE EQ "S"
      THEN
        BEGIN 
        P<TDAM> = HLRQADR;
        TYPE = "E"; 
        END 
  
      ELSE
        BEGIN 
        P<HLRQ> = HLRQADR;
        P<TDAM> = LOC(HLR$TDAM[0]); 
        P<LLRQ> = HLR$LRQADR[0];
        END 
  
      DODF = 0;                      # DEFAULT IS NOT TO ISSUE MESSAGE
                                     #
  
      IF TYPE EQ "I"
      THEN                           # CARTRIDGE MESSAGE #
        BEGIN 
        DOAF = B<59,1>MSG$AF$CTL[0];
        MSGS$SKEL[0] = SKELCART;
        MSGS$SM[0] = HLR$SM[0]; 
        IF FC EQ "LD" 
        THEN
          BEGIN 
          MSGS$CSN[0] = HLR$CSND[0];
          MSGS$ID[0] = HLR$CCOD[0]; 
          END 
  
        ELSE
          BEGIN 
          MSGS$CSN[0] = LLR$CSND[0];
          MSGS$ID[0] = LLR$CCOD[0]; 
          END 
  
        END 
  
      ELSE                           # FILE MESSAGE # 
        BEGIN 
        MSGS$SKEL[0] = SKELFILE;
        MSGS$PFN[0] = TDAMPFN[0]; 
        CH$10[0] = XCOD(O"1000000" + TDAMUI[0]);
        MSGS$UI[0] = CH$06[0];
  
        IF TYPE EQ "B"
        THEN                         # INSERT FAMILY NAME # 
          BEGIN 
          MSGS$FAM[0] = TDAMFAM[0]; 
          DOAF = B<58,1>MSG$AF$CTL[0];
          END 
  
        ELSE                         # ADD LENGTH AND TAG # 
          BEGIN 
          CH$10[0] = XCDD(TDAMFLN[0]);
          MSGS$LEN[0] = CH$06[0]; 
          DOAF = B<57,1>MSG$AF$CTL[0];
  
          MSGS$TAG[0] = SKELTAG;
          CH$10[0] = XCOD(O"100" + CODE); 
          MSGS$CODE[0] = CH$02[0];
          IF FC EQ "BS" OR FC EQ "ES" 
          THEN
            BEGIN 
            OFFSET = 59;
            END 
  
          ELSE
            BEGIN 
            OFFSET = 29;
            END 
  
          DODF = B<OFFSET-CODE,1>MSG$DF$CTL[0]; 
          B<OFFSET-CODE,1>MSG$ACT[0] = 1; 
  
          END 
  
        END 
  
      MSGS$FC[0] = FC;
  
      BZFILL(MSGS,TYPFILL"BFILL",38); 
  
  
      IF (DOAF NQ 0) AND RA$TRACE[0]
      THEN
        BEGIN 
        MESSAGE(MSGS[0],ACTDF); 
        END 
  
      IF DODF NQ 0
      THEN
        BEGIN 
        MSGS$SMA[0] = "  "; 
        MESSAGE(MSGS[0],UDFL1); 
        END 
  
      END  # MSGAFDF #
  
    TERM
PROC PFMEC((ERRSTAT),ACTION); 
  
# TITLE PFMEC - CONVERT *PFM* ERROR CODES.                            # 
  
      BEGIN  # PFMEC #
  
# 
**    PFMEC - CONVERT *PFM* ERROR CODES.
* 
*     *PFMEC* CONVERTS AN ERROR CODE RETURNED FROM *PFM* TO AN ERROR
*     ACTION CODE.  THIS ACTION CODE REPRESENTS WHAT TYPE OF ACTION 
*     EXEC SHOULD TAKE WHEN PROCESSING THE ERROR. 
* 
*     PROC PFMEC((ERRSTAT),ACTION)
* 
*     ENTRY      (ERRSTAT) - *PFM* ERROR CODE.
* 
*     EXIT       (ACTION) - ERROR ACTION. 
*                           (VALUES DEFINED IN *COMXMSC*) 
*                           = ERRST"NOERR". 
*                           = ERRST"WAIT".
*                           = ERRST"FATAL". 
*                           = ERRST"ABANDON". 
*                           = ERRST"SPECIAL". 
# 
  
      ITEM ERRSTAT    I;             # *PFM* ERROR CODE # 
      ITEM ACTION     I;             # ERROR ACTION # 
  
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMXMSC 
*CALL COMSPFM 
                                               CONTROL EJECT; 
  
      IF ERRSTAT EQ PFA OR ERRSTAT EQ FIN OR ERRSTAT EQ INA  ## 
        OR ERRSTAT EQ FTF OR ERRSTAT EQ PEA 
      THEN                           # DELAY CONDITION #
        BEGIN 
        ACTION = ERRST"WAIT"; 
        RETURN; 
        END 
  
      IF ERRSTAT EQ FBS OR ERRSTAT EQ FDA  ## 
        OR ERRSTAT EQ DTE OR ERRSTAT EQ IOE OR ERRSTAT EQ PRL  ## 
        OR ERRSTAT EQ DAF OR ERRSTAT EQ MSE OR ERRSTAT EQ EDA  ## 
        OR ERRSTAT EQ EPT OR ERRSTAT EQ EDP                    ## 
        OR ERRSTAT EQ FLC OR ERRSTAT EQ NEM OR ERRSTAT EQ FSE  ## 
        OR ERRSTAT EQ AIO OR ERRSTAT EQ ICU ##
        OR ERRSTAT EQ FIA OR ERRSTAT EQ PVE OR ERRSTAT EQ FND 
      THEN                           # ABANDON CONDITION #
        BEGIN 
        ACTION = ERRST"ABANDON";
        RETURN; 
        END 
  
      IF ERRSTAT EQ SPN OR ERRSTAT EQ TKL 
      THEN                           # SPECIAL CONDITION #
        BEGIN 
        ACTION = ERRST"SPECIAL";
        RETURN; 
        END 
  
      ACTION = ERRST"FATAL";         # FATAL CONDITION #
      RETURN; 
      END  # PFMEC #
  
    TERM
PROC TRACMSG((TDAMADR),(ACTV)); 
  
# TITLE TRACMSG - ISSUE TRACE MESSAGE.                                # 
  
      BEGIN  # TRACMSG #
  
# 
**    TRACMSG - ISSUE TRACE MESSAGE.
* 
*     *TRACMSG* ISSUES MESSAGES TO THE ACCOUNT DAYFILE FOR *STAGER* 
*     AND *DESTAGR* PROVIDING INFORMATION ON THE FILE STAGE AND 
*     DESTAGE REQUESTS BEING PROCESSED. 
* 
*     PROC TRACMSG((TDAMADR),(ACTV))
* 
*     ENTRY      (TRACMSG) - ADDRESS OF *TDAM* REQUEST BLOCK CONTAINING 
*                            FILE NAME AND FILE LENGTH. 
*                (ACTV) - 2 CHARACTER ACTIVITY CODE.
* 
*     MESSAGES   *STD1, FFFFFFF.* 
*                *STD2, FFFFFFF.* 
*                *STD3, FFFFFFF.* 
*                *STD4, FFFFFFF, LLLLLL.* 
*                *STD5, FFFFFFF.* 
*                *STS2, FFFFFFF.* 
*                *STS3, FFFFFFF.* 
*                *STS4, FFFFFFF, LLLLLL.* 
*                *STS5, FFFFFFF.* 
*                *STS6, FFFFFFF.* 
* 
*     NOTES      *ACTV* IS A 2 CHARACTER CODE IDENTIFYING THE ACTIVITY
*                WHICH OCCURED.  THE FIRST CHARACTER IS *S* FOR STAGE 
*                REQUESTS AND *D* FOR DESTAGE REQUESTS.  THE SECOND 
*                CHARACTER REPRESENTS THE ACTION AS FOLLOWS:  
*                  *1* - FILE ATTACHED FOR DESTAGE (UNDEFINED FOR 
*                        STAGE).
*                  *2* - CARTRIDGE LOADED.
*                  *3* - COPY TO BE INITIATED.
*                  *4* - COPY COMPLETE. 
*                  *5* - *PFC* HAS BEEN UPDATED.
*                  *6* - COPY FROM FIRST CARTRIDGE COMPLETE FOR A 
*                        MULTICARTRIDGE FILE (UNDEFINED FOR DESTAGE). 
# 
  
      ITEM TDAMADR    U;             # ADDRESS OF *TDAM* REQUEST BLOCK
                                     #
      ITEM ACTV       C(2);          # ACTIVITY RECORDED #
  
# 
****  PROC TRACMSG - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK OR ZERO FILL ITEM #
        PROC MSG;                    # ISSUE MESSAGE #
        PROC RMVBLNK;                # REMOVE EXCESS BLANKS # 
        FUNC XCDD C(10);             # CONVERT DECIMAL TO DISPLAY # 
        END 
  
# 
****  PROC TRACMSG - XREF LIST END. 
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS # 
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBTDM 
*CALL COMXACM 
*CALL COMXJCA 
  
      ITEM FLEN       C(10);         # DISPLAY CODED FILE LENGTH #
      ITEM FLNM       C(7);          # FILE NAME #
                                               CONTROL EJECT; 
      IF NOT RA$TRACE[0]
      THEN                           # TRACE MODE NOT SELECTED #
        BEGIN 
        RETURN; 
        END 
  
      P<TDAM> = TDAMADR;
      IF ACTV EQ "S4" OR ACTV EQ "D4" 
      THEN                           # INCLUDE FILE LENGTH IN MESSAGE # 
        BEGIN 
        ACCMMES[0] = ACCMSG4; 
        FLEN = XCDD(TDAMFLN[0]);
        ACCMFLEN[0] = C<4,6>FLEN; 
        END 
  
      ELSE
        BEGIN 
        ACCMMES[0] = ACCMSG3; 
        END 
  
      FLNM = TDAMPFN[0];
      BZFILL(FLNM,TYPFILL"BFILL",7);
      ACCMPFN[0] = FLNM;
      ACCMACTV[0] = ACTV; 
      RMVBLNK(ACCMSG[0],40);
      MSG(ACCMSG[0],ACTDF); 
  
      RETURN; 
      END  # TRACMSG #
  
    TERM
