Retro1.org codex

*DECK     NVFTURT 
USETEXT          TEXTNVF
USETEXT          TXTAPSS
 
PROC NVFTURT((VCB),PT,PRIAPP);
# TITLE NVFTURT - UPDATE RAU TABLE                                     #
 
      BEGIN  # NVFTURT #
# 
**    NVFTURT - UPDATE RAU TABLE. 
* 
*     E. THAVIKULWAT    81/11/09
*     C. BRION          83/05/10
* 
*     THIS PROCEDURE'S MAIN FUNCTION IS TO GET *PTAC* ENTRY THAT
*     MATCHES ON VCB AND TO DELETE ENTRY FROM *RAU* TABLE IF NEED TO
*     FOR AN INTERACTIVE DEVICE.  IT IS CALLED INTO EXECUTION BY THE
*     FOLLOWING PROCEDURES: 
*       *NVFTCB*    *NVFTRCN*   *NVFTRVD* 
* 
*     PROC NVFTURT
* 
*     ENTRY:  
*       VCB = VCB ORDINAL 
*       PRIAPP = TRUE IF THE *RAU* ENTRY IS FOR A PRIMARY APPLICATION.
*              = FALSE IF THE *RAU* ENTRY IS FOR A SECONDARY
*                APPLICATION, OR AN APPLICATION NOT INVOLVED IN LOANING.
* 
*     EXIT: 
*       PT = INDEX TO PTAC ENTRY. 
*       RAU TABLE UPDATED.
* 
*     METHOD: 
*       GET *PTAC* ENTRY THAT MATCHES ON VCB.  IF INTERACTIVE DEVICE
*       AND UNIQUE IDENTIFIER FLAG IS SET IN THE *AST* ENTRY FOR THIS 
*       APPLICATION, THEN DELETE IT'S ENTRY FROM THE *RAU* TABLE. 
# 
 
# 
****  PROC NVFTURT - XREF LIST. 
# 
 
      XREF
        BEGIN 
        PROC ABORT;          # ABORT JOB                               #
        PROC MESSAGE;        # SEND MESSAGE TO SYSTEM AND USER DAYFILE #
        PROC SSTRTS;         # REMOVE TABLE SPACE                      #
        END 
 
# 
****
# 
      ITEM AS         I;     # SUBSCRIPT FOR ARRAY AST                 #
      ITEM ASENTRY    I;     # NUMBER AST ENTRIES                      #
      ITEM FIND       B;     # EXIT LOOP VARIABLE                      #
      ITEM I          I;     # LOOP VARIABLE                           #
      ITEM MATCH      B;     # EXIT LOOP VARIABLE                      #
      ITEM NENTRY     I;     # NUMBER OF ENTRIES IN TABLE              #
      ITEM OFFSET     I;     # OFFSET FROM TOP OF TABLE TO THE ENTRY   #
      ITEM PRIAPP     B;     # PRIMARY APPLICATION INDICATOR           #
      ITEM PT         I;     # SUBSCRIPT FOR ARRAY PTAC                #
      ITEM RAU$ENTRY  I;     # NUMBER OF ENTRIES IN RAU TABLE          #
      ITEM VCB        I;     # VCB ORDINAL VARIABLE                    #
 
# 
*     FOLLOWING ARRAY CONTAINS MESSAGE ISSUED TO THE DAYFILE UPON NOT 
*     FINDING AN EXPECTED PTAC/RAU ENTRY. 
# 
      ARRAY DAYMSG[00:00] S(4); 
        BEGIN 
        ITEM DAY$MSG1   C(00,00,22) = ["NVFTURT - CANNOT FIND "]; 
        ITEM DAY$TYPE   C(02,12,04);   # PTAC OR RAU                   #
        ITEM DAY$MSG2   C(02,36,06) = [" ENTRY"]; 
        END 
# 
*     DETERMINE NUMBER OF AST ENTRIES.
# 
      ASENTRY = ASTLNGTH/ASTSIZ$; 
 
# 
*     SEARCH PTAC TABLE FOR ENTRY THAT MATCHES ON VCB.
# 
      MATCH  = FALSE; 
      NENTRY = PTALNGTH / PTACSIZ$;    # CALCULATE NUMBER OF ENTRIES   #
      FOR PT = 0 STEP 1 WHILE (NOT MATCH AND PT LS NENTRY)
      DO
        BEGIN 
        IF PTA$VCB[PT] EQ VCB 
        THEN                           # PTAC ENTRY FOUND              #
          BEGIN 
          FIND = TRUE;
# 
*     IF INTERACTIVE DEVICE, AND THE UNIQUE IDENTIFIER FLAG IS SET
*     IN THE *AST* ENTRY FOR THIS APPLICATION, THEN ITS ENTRY IN
*     THE *RAU* TABLE MUST BE DELETED.  IF PRIAPP IS TRUE, THEN SEARCH
*     THE *AST* TABLE FOR THE PRIMARY APPLICATION ENTRY.  IF PRIAPP 
*     IS FALSE, THEN SEARCH THE *AST* TABLE FOR THE SWITCHED APPLICATION
*     ENTRY.
# 
          IF PRIAPP 
          THEN
            BEGIN 
            FOR AS = 0 STEP 1 WHILE 
              (AS LS ASENTRY AND
               AST$AN[AS] NQ PTA$PRIAN[PT]) 
            DO
              BEGIN 
              END 
            END 
          ELSE
            BEGIN 
            FOR AS = 0 STEP 1 WHILE 
              (AS LS ASENTRY AND
               AST$PANAM[AS] NQ PTA$SWTAPP[PT]) 
            DO
              BEGIN 
              END 
            END 
 
          IF AS LS ASENTRY
          THEN
            BEGIN 
            IF    (    (PTA$DT[PT] EQ DT$CONS)
                    OR (PTA$DT[PT] EQ DT$USER)
                    OR (PTA$DT[PT] EQ DT$CLP ) )
              AND ( AST$UIDF[AS] )
            THEN                         # INTERACTIVE AND UNIQUE      #
              BEGIN 
              FIND = FALSE; 
              RAU$ENTRY = RAULNGTH / RAUSIZ$; 
              FOR I = 0 STEP 1 WHILE (NOT FIND AND I LS RAU$ENTRY)
              DO
                BEGIN 
                IF (RAU$AN[I] EQ AST$AN[AS])
                  AND (RAU$UIDX[I] EQ PTA$UIDX[PT]) 
                  AND (RAU$FNAM[I] EQ PTA$FNAM[PT]) 
                THEN                     # RAU ENTRY FOUND             #
                  BEGIN 
                  OFFSET = I * RAUSIZ$;          # OFFSET TO THE ENTRY #
                  SSTRTS(P<RAU>,OFFSET,RAUSIZ$);    # DELETE RAU ENTRY #
                  FIND = TRUE;           # EXIT LOOP                   #
                  END 
                END 
              END 
            END 
          MATCH = TRUE;                  # EXIT LOOP                   #
          END 
        END 
 
      PT = PT - 1;
 
 
      IF NOT MATCH
      THEN
        BEGIN 
        DAY$TYPE[0] = "PTAC"; 
        MESSAGE(DAYMSG,0);             # MSG TO SYSTEM AND USR DAYFILE #
        ABORT;
        END 
 
      $BEGIN
      IF NOT FIND 
      THEN
        BEGIN 
        DAY$TYPE[0] = "RAU "; 
        MESSAGE(DAYMSG,0);             # MSG TO SYSTEM AND USR DAYFILE #
        ABORT;               # ABORT NVF                               #
        END 
      $END
 
      END  # END NVFTURT #
 
TERM