Retro1.org codex

*DECK NVFTURL 
USETEXT          TEXTNVF
USETEXT          TXTAPSS
 
PROC NVFTURL((PT)); 
# TITLE NVFTURL - UPDATE RML TABLE                                     #
 
      BEGIN  # NVFTURL #
# 
**    NVFTURL - UPDATE RML TABLE. 
* 
*     G. A. HUGHES      86/01/30
* 
*     THIS PROCEDURE'S MAIN FUNCTION IS TO DELETE A USER'S ENTRY FROM 
*     THE *RML* TABLE USED TO RESTRICT MULTIPLE INTERACTIVE ACCESS. 
*     IT IS CALLED INTO EXECUTION BY THE FOLLOWING PROCEDURES:  
*       *NVFTCRN*   *NVFTETC* 
* 
*     PROC NVFTURL
* 
*     ENTRY:  
*       PT  = POINTER TO PTAC ENTRY.
* 
*     EXIT: 
*       PT = INDEX TO PTAC ENTRY. 
*       RML TABLE UPDATED.
* 
*     METHOD: 
*       IF THE DEVICE IS INTERACTIVE, SEARCH FOR THE MATCHING ENTRY IN
*       THE *RML* TABLE.  IF FOUND DELETE IT FROM THE TABLE, IF NOT 
*       ISSUE AN INFORMATIVE DAYFILE MESSAGE. 
# 
 
# 
****  PROC NVFTURL - XREF LIST. 
# 
 
      XREF
        BEGIN 
        PROC MESSAGE;        # SEND MESSAGE TO SYSTEM AND USER DAYFILE #
        PROC SSTRTS;         # REMOVE TABLE SPACE                      #
        END 
 
# 
****
# 
      ITEM FIND       B;     # RML ENTRY INDICATOR                     #
      ITEM I          I;     # LOOP VARIABLE                           #
      ITEM NENTRY     I;     # NUMBER OF ENTRIES IN TABLE              #
      ITEM PT         I;     # SUBSCRIPT FOR ARRAY PTAC                #
 
# 
*     FOLLOWING ARRAY CONTAINS MESSAGE ISSUED TO THE DAYFILE UPON NOT 
*     FINDING AN EXPECTED RML ENTRY.
# 
      ARRAY DAYMSG[00:00] S(4); 
        BEGIN 
        ITEM DAY$MSG1   C(00,00,22) = ["NVFTURL - CANNOT FIND "]; 
        ITEM DAY$MSG2   C(02,12,10) = ["RML ENTRY."]; 
        END 
 
      IF (PTA$DT[PT] EQ DT$CONS) OR (PTA$DT[PT] EQ DT$USER) 
                                 OR (PTA$DT[PT] EQ DT$CLP ) 
      THEN                               # INTERACTIVE DEVICE          #
        BEGIN 
        FIND = FALSE; 
        FOR I = 0 STEP 1 WHILE (NOT FIND AND I LS RMLLNGTH) 
        DO
          BEGIN 
          IF (RML$UIDX[I] EQ PTA$UIDX[PT]) AND
             (RML$FNAM[I] EQ PTA$FNAM[PT])
          THEN                           # RML ENTRY FOUND             #
            BEGIN 
            SSTRTS(P<RML>,I,RMLSIZ$);    # DELETE RML ENTRY            #
            FIND = TRUE;                 # EXIT LOOP                   #
            END 
          END 
        END 
      IF NOT FIND 
      THEN
        BEGIN 
        MESSAGE(DAYMSG,0);             # MSG TO SYSTEM AND USR DAYFILE #
        END 
 
      END  # END NVFTURL #
 
TERM