Retro1.org codex

*DECK NVFAIAM 
USETEXT TEXTNVF 
USETEXT TXTANVF 
PROC NVFAIAM((PAC),(MTYP)); 
# TITLE NVFAIAM - A-A ISSUE ACCOUNTING MESSAGE
  # 
 
      BEGIN  # NVFAIAM #
# 
**    NVFAIAM - A-A ISSUE ACCOUNTING MESSAGE. 
* 
*      C. BRION              82/10/07 
* 
*     THIS PROCEDURE ISSUES ACCOUNT MESSAGES TO THE SYSTEM'S ACCOUNT
*     DAYFILE.  IT IS CALLED INTO EXECUTION BY THE FOLLOWING
*     PROCEDURES: 
*       *NVFAACC*   *NVFATAC*   *NVFAEAC*   *NVFAPSV*   *NVFARVD* 
* 
*     PROC NVFAIAM((PAC),(MTYP))
* 
*     ENTRY:  
*       PAC   = POINTER TO PAAC ENTRY 
*       MTYP = TYPE OF ACCOUNT MESSAGE TO ISSUE:  
*         ABAC = 0
*         ABAA = 1
*         ABAE = 2
*         ABEA = 3
*         ABRE = 4
*         AEAA = 5
*         ABAR = 6
* 
*       NOTES:  
* 
*         THE FOLLOWING ARE THE FORMATS OF THE A-A ACCOUNTING MESSAGES: 
* 
*         ABAC, C1, USERNUM, FAMILY, APPL.
*         ABAC, C2, SNODE, DNODE. 
* 
*         ABAA, APPL, RAPPL, RHID.
* 
*         ABAE, C1, USERNUM, FAMILY, RAPPL. 
*         ABAE, C2, SNODE, DNODE. 
* 
*         ABEA, APPL, RAPPL, RHID.
* 
*         ABRE, APPL. 
* 
*         AEAA, C1, APPL, RAPPL, RHID.
*         AEAA, C2, XXXXXXSECS. 
* 
*         ABAR, SERVICE(APPL), SNODE, DNODE.
* 
* 
*     EXIT: 
*       APPROPRIATE ACCOUNT MESSAGE ISSUED TO THE SYSTEM'S ACCOUNT
*       DAYFILE.
* 
*     METHOD: 
*       FOR EACH PARAMETER OF THE ACCOUNT MESSAGE, CALL INTERNAL
*       PROCEDURE *AXTRACT* TO DELETE TRAILING ZEROES AND BLANKS. 
*       WHEN MESSAGE IS COMPLETE, CALL MACREL ROUTINE *MESSAGE* TO
*       SEND IT TO THE ACCOUNT DAYFILE. 
# 
 
# 
****  PROC NVFAIAM - XREF LIST. 
# 
 
      XREF
        BEGIN 
        PROC MESSAGE;        # SEND MESSAGE # 
        PROC NVFTCCT;        # CALCULATE APPLICATION CONNECT TIME # 
        PROC SSBEBF;         # EXTRACT BIT FIELDS # 
        FUNC XCDD;           # MACREL CONVERT INTEGER TO DISPLAY DEC #
        PROC SSBSBF;         # SS-STORE BIT FIELD # 
        END 
 
 
# 
****
# 
 
      DEF  COMMA$   #O"5655"#;         # COMMA FOLLOWED BY ONE BLANK   #
      DEF  ACCMSIZ$ #5#;               # SIZE OF MSG ASSEMBLY AREA #
      DEF  PERIOD$  #O"57000000"#;     # PERIOD FOLLOWED BY ZERO BYTE  #
      DEF  SECS$    #O"2305032357000000"#; # "SECS." FOLLOWED BY 0 BYTE#
      ITEM BITSBF     I;     # STARTING BIT OF MESSAGE ASSEMBLY AREA   #
      ITEM EBFNAME    I;     # NAME TO BE ENTERED INTO MESSAGE         #
      ITEM I          I;     # LOOP VARIABLE                           #
      ITEM LEN        I;     # NUMBER OF BITS TO STORE                 #
      ITEM MTYP       I;     # TYPE OF ACCOUNT MESSAGE TO ISSUE        #
      ITEM ORDSBF     I;     # STARTING WORD OF MESSAGE ASSEMBLY AREA  #
      ITEM PAC        I;     # SUBSCRIPT FOR ARRAY PAAC                #
      ITEM TEMP       I;     # TEMPORARY STORAGE AREA                  #
      ITEM INDXSTART  I;     # TEMP INDEX START LOCATION #
      ITEM CTYP         I;   # CONNECTION TYPE INDICATOR #
      ITEM INDXSTOP   I;     # TEMP INDEX STOP LOCATION # 
      ITEM NUM        I;     # NUMBER OF CHARACTERS TO EXTRACT #
      ITEM J          I;     # LOOP VAR # 
 
# 
*     THE FOLLOWING ARRAY IS THE MESSAGE ASSEMBLY AREA. 
# 
 
      ARRAY ACCMSG [00:00] S(ACCMSIZ$); 
        BEGIN 
        ITEM ACC$TYP  C(00,00,10);
        ITEM ACC$C2   C(00,36,02);
        ITEM ACC$WORD U(00,00,60);
        END 
 
# 
*     THE FOLLOWING ARRAY CONTAINS THE VALUES FROM THE PAAC ENTRY THAT
*     NEED TO BE CONVERTED BY AXTRACT.
# 
 
      ARRAY VALUES [00:05] S(1);
        BEGIN 
        ITEM VAL$WORD U(00,00,60);
        ITEM VAL$CWRD C(00,00,03);
        END 
 
# 
*     THE FOLLOWING ARRAY DEFINES THE TYPES OF ACCOUNTING MESSAGES
*     THAT ARE A-A. THIS ARRAY ORDER MUST COINCIDE WITH THE VALUE 
*     DEFINITIONS FOR THE ACCOUNT MSG TYPES IN TXTANVF TEXT.
# 
 
      ARRAY ACCTYP [00:06] S(1);
        BEGIN 
        ITEM ACT$WORD   C(00,00,10);
        ITEM ACT$TYPE   C(00,00,10) = ["ABAC, C1, ",
                                       "ABAA, ",
                                       "ABAE, C1, ",
                                       "ABEA, ",
                                       "ABRE, ",
                                       "AEAA, C1, ",
                                       "ABAR, "]; 
        END 
 
# 
**    CLRMAA - UTILITY DEFINITION TO CLEAR MAA. 
# 
 
      BASED ARRAY CLRMAA [00:ACCMSIZ$] S(1);
        BEGIN 
        ITEM CLR$WORD  U(00,00,60); 
        END 
 
# 
*     THE FOLLOWING ARRAY IS FOR STORING THE LOCAL SOURCE AND 
*     DESTINATION NODES.
# 
 
      ARRAY NODES [00:00] S(2); 
        BEGIN 
        ITEM SNODE   U(00,00,60); 
        ITEM SNODEC  C(00,42,03); 
        ITEM DNODE   U(01,00,60); 
        ITEM DNODEC  C(01,42,03); 
        END 
 
# 
*     THE FOLLOWING ARRAY CONTAINS THE NUMBER OF CHARACTERS THAT WILL 
*     NEED TO BE CONVERTED. THERE IS AN INDEX RELATION TO EACH ARRAY
*     ENTRY HERE AND IN THE VALUES ARRAY. 
# 
 
      ARRAY NUMCHAR [00:05] S(1); 
        BEGIN 
        ITEM NUM$VAL  U(00,00,60);
        END 
 
# 
*     ***** MAIN PROCEDURE STARTS HERE *****
# 
 
# 
*     CLEAR THE MAA (MESSAGE ASSEMBLY AREA).
# 
 
      P<CLRMAA> = LOC(ACCMSG);
      FOR I = 0 STEP 1 UNTIL (ACCMSIZ$ - 1) 
      DO
        BEGIN 
        CLR$WORD[I] = 0;
        END 
 
      ACC$TYP[0] = ACT$WORD[MTYP];       # SET MESSAGE TYPE # 
 
# 
      EXTRACT THE NEEDED VALUES FROM THE PAAC ENTRY AND STORE INTO THE
      VALUES ARRAY. 
# 
 
      VAL$WORD[0] = PA$UWORD[PAC];
      VAL$WORD[1] = PA$FWORD[PAC];
      VAL$WORD[2] = PA$RAPWRD[PAC]; 
      VAL$WORD[3] = PA$IAPWRD[PAC]; 
      VAL$WORD[4] = PA$RAPWRD[PAC]; 
      VAL$WORD[5] = PA$RHWRD[PAC];
 
# 
      IF THE MESSAGE TYPE IS EITHER ABAC OR ABAE THEN THE FIRST LINE OF 
      THE MESSAGE WILL BE STARTED IN WORD 1, BIT 0. THERE WILL BE 7 
      CHARACTERS IN EACH OF THE FIRST 3 VALUES THAT WILL HAVE TO BE 
      CONVERTED AND PACKED INTO THE MAA (MESSAGE ASSEMBLY AREA).
# 
 
      IF ((MTYP EQ ABAC$) OR (MTYP EQ ABAE$)) 
      THEN
        BEGIN 
        ORDSBF = 1; 
        BITSBF = 0; 
        INDXSTART = 0;
        INDXSTOP = 2; 
        NUM$VAL[0] = 7; 
        NUM$VAL[1] = 7; 
        NUM$VAL[2]= 7;
        END 
      ELSE IF ((MTYP EQ ABAA$) OR (MTYP EQ ABEA$))
 
# 
      OR IF THE MESSAGE TYPE IS ABAA OR ABEA THEN THE STARTING MAA WORD 
      ORDINAL IS 0 AND THE STARTING BIT IS 36. THE PAAC VALUES IN VALUES
      ARRAY SUBSCRIPTS 3,4,5 ARE TO BE EXTRACTED AND THERE ARE 7,7 AND
      3 CHARACTERS IN THOSE VALUES RESPECTIVELY THAT ARE TO PACKED INTO 
      THE MAA.
# 
 
      THEN
        BEGIN 
        ORDSBF = 0; 
        BITSBF = 36;
        INDXSTART = 3;
        INDXSTOP = 5; 
        NUM$VAL[3] = 7; 
        NUM$VAL[4] = 7; 
        NUM$VAL[5] = 3; 
        END 
      ELSE IF ((MTYP EQ ABRE$) OR (MTYP EQ ABAR$))
 
# 
      OR IF THE MESSAGE TYPE IS EITHER ABRE OR ABAR THEN THERE IS ONLY
      ONE PAAC ENTRY VALUE TO BE EXTRACTED AND PACKED INTO THE MAA. 
      THAT VALUE MAY HAVE 7 CHARACTER MAX LENGTH. 
# 
 
      THEN
        BEGIN 
        ORDSBF = 0; 
        BITSBF = 36;
        INDXSTART = 3;
        INDXSTOP = 3; 
        NUM$VAL[3] = 7; 
        END 
      ELSE IF MTYP EQ AEAA$ 
 
# 
      OR THE MESSAGE TYPE MAY BE AEAA IN WHICH CASE THE FIRST 3 PAAC
      VALUES OF 7,7 AND 3 CHARACTER LENGTHS MUST BE EXTRACTED AND PACKED
      INTO THE MAA. THEY MUST BE PACKED INTO DIFFERENT LOCATIONS OF THE 
      MAA, HENCE THE SPECIAL CASE FROM ABAA AND ABEA TYPES. 
# 
 
      THEN
        BEGIN 
        ORDSBF = 1; 
        BITSBF = 0; 
        INDXSTART = 3;
        INDXSTOP = 5; 
        NUM$VAL[3] = 7; 
        NUM$VAL[4] = 7; 
        NUM$VAL[5] = 3; 
        END 
 
# 
      GENERATE THE FIRST LINE OF THE MESSAGE IN THE MAA.
      SETUP THE LOCAL VARIABLES CONTAINING THE VALUE TO BE EXTRACTED
      AND PACKED AND THE NUMBER OF CHARACTERS TO PROCESS. THE AXTRACT 
      PROCEDURE WORKS WITH THESE VARIABLES. 
# 
 
      TEMP = COMMA$;
      LEN = 12; 
 
# 
      CONVERT THE SNODE AND DNODE VALUES. 
# 
 
      SNODE[0] = XCDD(PA$SNODE[PAC] + 1000);
      DNODE[0] = XCDD(PA$DNOD[PAC] + 1000); 
 
 
      FOR I =INDXSTART STEP 1 UNTIL INDXSTOP
      DO
        BEGIN 
        EBFNAME = VAL$WORD[I];
        NUM = NUM$VAL[I]; 
        AXTRACT;
 
# 
      IF AT LAST VALUE OF LINE, THEN MUST TERMINATE LINE WITH PERIOD
      AND A BLANK ONLY IF IT IS NOT AN ABAR TYPE SINCE THIS TYPE OF 
      MESSAGE NEEDS THE SOURCE AND DESTINATION NODES APPENDED.
# 
        IF (I EQ INDXSTOP) AND
          (MTYP NQ ABAR$) 
        THEN
          BEGIN 
          TEMP = PERIOD$; 
          LEN = 24; 
          END 
 
# 
      STORE THE TERMINATOR (EITHER COMMA OR PERIOD) INTO MAA. 
# 
 
        SSBSBF(ACCMSG,ORDSBF,BITSBF,LEN,TEMP);
 
        END 
 
# 
      NOW IF THE TYPE IS A ABAR, EXTRACT AND PACK THE SNODE AND DNODE 
      INTO THE MAA. 
# 
 
      IF MTYP EQ ABAR$
      THEN
        BEGIN 
        VAL$CWRD[0] = SNODEC[0];
        VAL$CWRD[1] = DNODEC[0];
        NUM$VAL[0] = 3; 
        NUM$VAL[1] = 3; 
        INDXSTART = 0;
        INDXSTOP = 1; 
 
        FOR J = INDXSTART STEP 1 UNTIL INDXSTOP 
        DO
          BEGIN 
          EBFNAME = VAL$WORD[J];
          NUM = NUM$VAL[J]; 
          AXTRACT;
 
# 
      TERMINATE AS BEFORE WITH EITHER COMMA OR PERIOD.
# 
 
          IF J EQ INDXSTOP
          THEN
            BEGIN 
            TEMP = PERIOD$; 
            LEN = 24; 
            END 
 
          SSBSBF(ACCMSG,ORDSBF,BITSBF,LEN,TEMP);
 
          END 
        END 
 
# 
      SEND THE FIRST LINE OF MESSAGE (MAYBE LAST).
# 
 
      MESSAGE(ACCMSG,5);
 
# 
      PREPARE THE SECOND LINE OF THE MESSAGE TYPES THAT REQUIRE A 
      SECOND LINE.(ABAC, ABAE, AEAA)
      SAME PROCEDURAL MANNER AS BEFORE. SET UP THE VALUES AND NUMBER
      OF CHARACTERS THAT NEED TO BE EXTRACTED AND PACKED THEN TERMINATE 
      THE LINE WITH THE PERIOD, ZERO BYTE SEQUENCE. 
# 
 
      IF ((MTYP EQ ABAC$) OR (MTYP EQ ABAE$) OR (MTYP EQ AEAA$))
      THEN
        BEGIN 
        ACC$C2[0] = "C2"; 
        ORDSBF = 1; 
        BITSBF = 0; 
 
        IF MTYP NQ AEAA$
        THEN
          BEGIN 
 
# 
      FOR THE ABAC AND ABAE MESSAGE TYPES THE SNODE AND DNODE VALUES
      MUST BE PACKED INTO THE MAA.
# 
 
          VAL$CWRD[0] = SNODEC[0];
          VAL$CWRD[1] = DNODEC[0];
          NUM$VAL[0] = 3; 
          NUM$VAL[1] = 3; 
          INDXSTART = 0;
          INDXSTOP = 1; 
 
          TEMP = COMMA$;
          LEN = 12; 
 
          FOR J = INDXSTART STEP 1 UNTIL INDXSTOP 
          DO
            BEGIN 
            EBFNAME = VAL$WORD[J];
            NUM = NUM$VAL[J]; 
            AXTRACT;
            IF J EQ INDXSTOP
            THEN
              BEGIN 
              TEMP = PERIOD$; 
              LEN = 24; 
              END 
 
            SSBSBF(ACCMSG,ORDSBF,BITSBF,LEN,TEMP);
 
            END 
 
          END 
        ELSE # TYPE AEAA MESSAGE #
          BEGIN 
 
# 
      SET A-A CONNECT TIME REQUEST AND CALL TO CALCULATE THE CONNECT
      TIME FOR THE MESSAGE
# 
 
          CTYP = AATIME$; 
          NVFTCCT(PAC,0,EBFNAME,CTYP);
 
# 
      REFINE CONNECT TIME RETURNED AND PACK INTO MAA. 
# 
 
          NUM = 7;
          AXTRACT;
 
# 
      APPEND THE SECS. SUFFIX TO THE MESSAGE. 
# 
 
          TEMP = SECS$; 
          LEN = 48; 
 
# 
      STORE FINAL TERMINATOR INTO THE SECOND LINE.
# 
 
          SSBSBF(ACCMSG,ORDSBF,BITSBF,LEN,TEMP);
 
          END 
 
# 
      ISSUE THE SECOND LINE OF THE MESSAGE. 
# 
 
      MESSAGE(ACCMSG,5);
 
      END 
 
# 
*     *************************************************************** 
# 
 
CONTROL EJECT;
 
PROC AXTRACT; 
# TITLE AXTRACT - A-A EXTRACT NON-ZERO AND NON-BLANK CHARACTERS. #
      BEGIN # AXTRACT # 
 
# 
**    AXTRACT - A-A EXTRACT NON-ZERO,NON-BLANK CHARACTERS.
* 
*     C. BRION        82/10/15. 
* 
*     THIS PROCEDURE IS LOCAL TO NVFAIAM AND ITS FUNCTION IS TO EXTRACT 
*     NON-ZERO AND NON-BLANK TRAILING CHARACTERS FROM VALUES AND THEN 
*     STORE THE RESULTING CHARACTER(S). 
* 
*     PROC AXTRACT
* 
*     ENTRY:  
*       VALUE RESIDES IN EBFNAME, LEFT JUSTIFIED. 
*       NUMBER OF CHARACTERS RESIDES IN NUM.
*       STORE WORD ORDINAL AND BIT ORDINAL WITHIN WORD IN ORDSBF,BITSBF.
*       STORE ADDRESS IN ACCMSG.
* 
# 
 
      ITEM OEBF       I;
      ITEM BEBF       I;
      ITEM I          I;
      ITEM TCHAR      I;
      ITEM FIN        B;
 
# 
*     **** AXTRACT PROCEDURE STARTS HERE. ****
# 
 
# 
      INITIALIZE THE EXTRACT ORDINALS 
# 
 
      OEBF = 0; 
      BEBF = 0; 
      FIN = FALSE;
 
# 
      LOOP THROUGH THE VALUE WORD. WHEN A NON-BLANK OR NON-ZERO 
      CHARACTER FOUND, IT IS STORED INTO STORE ADDRESS. OTHERWISE,
      THE PROCESS IS FINISHED. DO NOT SCAN MORE THAN NUM CHARACTERS.
# 
 
      FOR I = 0 STEP 1 WHILE (I LS NUM AND NOT FIN) 
      DO
        BEGIN 
        SSBEBF(EBFNAME,OEBF,BEBF,6,TCHAR);
        IF ((TCHAR EQ 0) OR (TCHAR EQ " ")) 
        THEN
          BEGIN 
          FIN = TRUE; 
          END 
        ELSE
          BEGIN 
          SSBSBF(ACCMSG,ORDSBF,BITSBF,6,TCHAR); 
          END 
        END 
 
      END # AXTRACT # 
 
      END # NVFAIAM # 
 TERM 
*ENDIF