*DECK DB$JLH
USETEXT CDCSCTX 
USETEXT JLPCMTX 
  
      PROC DB$JLH;
      BEGIN 
 #
* *   DB$JLH -- CREATE A LOGGING RECORD          PAGE  1
* *   BOB MCALLESTER                             DATE  12/01/80 
* 
* DC  PURPOSE 
* 
*     OBTAIN A WORKING AREA FOR THE LOGGING RECORD. 
*     INITIALIZE IT WITH THE COMMONLY AVAILABLE DATA. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     NONE
* 
* D   ASSUMPTIONS 
* 
*     JOURNAL LOG COMMON
*       PARLEN               LENGTH (CHARS) OF THE STUB OF THE RECORD.
* 
*     CDCS COMMON 
*       RCB POINTER 
*       TQT POINTER 
*       SALX
*       IF LOC(TQT) NOT EQUAL TO TQTMTR 
*         RSB POINTER 
* 
* DC  EXIT CONDITIONS 
* 
*     P<JLREC> CONTAINS THE ADDRESS OF THE INITIALIZED RECORD STUB. 
* 
* DC  CALLING ROUTINES
* 
*     SYMBIONTS THAT MUST PRODUCE LOG RECORDS.
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC CLOCK;       # GET THE CURRENT TIME. ( HH.MM.SS.)      #
      XREF FUNC DB$CDEC C(10);  # BINARY TO DECIMAL WITH ZERO FILL     #
      XREF PROC DB$FLOP;     # GENERATE A FLOW POINT ENTRY             #
      XREF PROC DB$MBA;      # ALLOCATE A MANAGED BUFFER               #
      XREF PROC JDATE;       # GET THE SERIAL DATE- OFTEN CALLED JULIAN#
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     JOURNAL LOG RECORD HEADER 
* 
* DC  DESCRIPTION 
* 
*     MEMORY IS ALLOCATED FOR THE JOURNAL LOG RECORD, EXCLUSIVE OF
*     THE RECORD IMAGE WHICH IS REQUIRED FOR BEFORE/AFTER LOG RECORDS.
*     MEMORY IS ALLOCATED BY DB$MBA SO IT WILL BE FREED BY DB$WRP.
*     DEFAULT VALUES AND UNUSED FIELDS ARE INITIALIZED. 
* 
*     DATE, TIME AND SCHEMA ID ARE SET. 
* 
*     IF THE TASK IS NOT AN INTERNAL TASK, THE RUN-UNIT ID
*       AND THE USER PROGRAM ID ARE SET.
 #
  
  
#     S T A R T   O F   D B $ J L H   E X E C U T A B L E   C O D E    #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("JLH"); 
      CONTROL ENDIF;
  
      DB$MBA((PARLEN+9)/10,P<JLREC>);  # GET THE BUFFER                #
  
      JLHDWDB[0] = DFJLWDB; 
      JLHDWDC[0] = DFJLWDC;  # DEFAULT AND UNUSED FIELD VALUES         #
      JLHDWDD[0] = DFJLWDD; 
      JLHDWDE[0] = DFJLWDE; 
      JLHDUSID[0] = " ";
  
      JLHDSCID[0] = DB$CDEC(SASCHID[SALX],4); 
      JDATE(JULDAT);
      CLOCK(TIME);
      JLHDDATE[0] = C<5,5>JULDAT; 
      JLHDTIME[0] = TIME; 
  
      IF LOC(TQT) NQ TQTMTR 
      THEN
                             # IT IS NOT AN INTERNAL TASK              #
        BEGIN 
        IF B<24,18>TQRUID[0] EQ 0 
        THEN                 # (NOS) USE A FOUR CHARACTER ID           #
          BEGIN 
          JLHDJBID[0] = C<0,4>TQRUID[0];
          END 
        ELSE                 # (NOS/BE) USE A SEVEN CHARACTER ID       #
          BEGIN 
          JLHDJBID[0] = C<0,7>TQRUID[0];
          END 
        JLHDUSID[0] = TQPRNAME[0];
        END 
  
      RETURN; 
      END 
  
      TERM
