Retro1.org codex

*DECK     NVFTIAM 
USETEXT          TEXTNVF
USETEXT          TXTANVF
 
PROC NVFTIAM((PT),(MTYP));
# TITLE NVFTIAM - ISSUE ACCOUNTING MESSAGE                             #
 
      BEGIN  # NVFTIAM #
# 
**    NVFTIAM - ISSUE ACCOUNTING MESSAGE. 
* 
*     E. THAVIKULWAT    81/10/22
* 
*     THIS PROCEDURE ISSUES ACCOUNT MESSAGES TO THE SYSTEM'S ACCOUNT
*     DAYFILE.  IT IS CALLED INTO EXECUTION BY THE FOLLOWING
*     PROCEDURES: 
*       *NVFTACC*   *NVFTCRN*   *NVFTETC*   *NVFTPSV*   *NVFTRVD* 
*       *NVFTPUV* 
* 
*     PROC NVFTIAM((PT),(MTYP)) 
* 
*     ENTRY:  
*       PT   = POINTER TO PTAC ENTRY
*       MTYP = TYPE OF ACCOUNT MESSAGE TO ISSUE:  
*                 1 = ABUN
*                 2 = AEUN
*                 3 = ABAP
*                 4 = AEAP
*                 5 = ABER
*TEXT 
*                 6 = ABIC
*                 7 = SIPI
*ENDTEXT
* 
*     EXIT: 
*       APPROPRIATE ACCOUNT MESSAGE ISSUED TO THE SYSTEM'S ACCOUNT
*       DAYFILE.
* 
*     NOTES:  
*       FOLLOWING ARE THE FORMATS OF THE ACCOUNT MESSAGES:  
*         1) ABUN, USERNUM, FAMNAME, TRMNAME. 
*         2) AEUN, C1, USERNUM, FAMNAME, TRMNAME. 
*            AEUN, C2, XXXXXXSECS.
*         3) ABAP, C1, USERNUM, FAMNAME, TRMNAME. 
*            ABAP, C2, APPNAME. 
*         4) AEAP, C1, USERNUM, FAMNAME, TRMNAME. 
*            AEAP, C2, APPNAME, XXXXXXSECS. 
*         5) ABER, USERNUM, FAMNAME, TRMNAME. 
*TEXT 
*         6) ABIC, CHARNUMBER, PROJNUMBER, TRMNAME. 
*         7) SIPI, PERSONAL IDENTIFIER. 
*ENDTEXT
* 
*     METHOD: 
*       FOR EACH PARAMETER OF THE ACCOUNT MESSAGE, CALL INTERNAL
*       PROCEDURE *EXTRACT* TO DELETE TRAILING ZEROES AND BLANKS. 
*       WHEN MESSAGE IS COMPLETE, CALL MACREL ROUTINE *MESSAGE* TO
*       SEND IT TO THE ACCOUNT DAYFILE. 
# 
 
# 
****  PROC NVFTIAM - XREF LIST. 
# 
 
      XREF
        BEGIN 
        PROC MESSAGE;        # SEND MESSAGE                            #
        PROC NVFTCCT;        # CALCULATE APPLICATION CONNECT TIME      #
        PROC SSBEBF;         # EXTRACT BIT FIELDS                      #
        PROC SSBSBF;         # STORE BIT FIELDS                        #
        END 
 
# 
****
# 
      DEF  COMMA$   #O"5655"#;         # COMMA FOLLOWED BY ONE BLANK   #
      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    C(20); # NAME TO BE ENTERED IN 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 PT         I;     # SUBSCRIPT FOR ARRAY PTAC                #
      ITEM CNTYP         I;          # CONNECTION TYPE INDICATOR #
      ITEM TEMP       I;     # TEMPORARY STORAGE AREA                  #
      ITEM TERMVAL    I;     # NUMBER OF PARAMS IN ACCOUNT MESSAGE - 1 #
 
# 
*     FOLLOWING ARRAY IS THE ASSEMBLY AREA FOR THE ACCOUNT MESSAGES.
# 
      ARRAY ACCMSG[00:00] S(6); 
        BEGIN 
        ITEM ACC$TYP    C(00,00,10);   # MESSAGE TYP                   #
        ITEM ACC$C2     C(00,36,02);   # AREA FOR LITERAL C2           #
        END 
 
# 
*     FOLLOWING ARRAY DEFINES THE TYPE OF ACCOUNT MESSAGES. 
# 
      ARRAY ACCTYP[00:06] S(1); 
        BEGIN 
        ITEM ACT$WORD   C(00,00,10);   # FULL WORD REFERENCE           #
        ITEM ACT$TYPE   C(00,00,10) = 
            ["ABUN, ","AEUN, C1, ","ABAP, C1, ","AEAP, C1, ","ABER, ",
             "ABIC, ","SIPI, "];
        END 
 
# 
*     INFORMATION TO BE ENTERED INTO THE ACCOUNT MESSAGES ARE SAVED 
*     IN THE FOLLOWING ARRAY. 
# 
      ARRAY VALUES[00:02] S(2); 
        BEGIN 
        ITEM VAL$WORD   C(00,00,20);
        END 
 
      IF (MTYP EQ SIPI$)
      THEN                             # SET PERSONAL IDENTIFIER       #
        BEGIN 
        VAL$WORD[0] = PTA$PID[PT];
        END 
      ELSE
        BEGIN 
        IF (MTYP EQ ABIC$)
        THEN                           # SET CHARGE AND PROJECT NUMBER #
          BEGIN 
          VAL$WORD[0] = PTA$CHGNUM[PT];# CHARGE NUMBER                 #
          VAL$WORD[1] = PTA$PRJNUM[PT];# PROJECT NUMBER                #
          END 
        ELSE                           # SET USER NAME AND FAMILY NAME #
          BEGIN 
          VAL$WORD[0] = PTA$UNUM[PT];  # USER NAME                     #
          VAL$WORD[1] = PTA$FNAM[PT];  # FAMILY NAME                   #
          END 
        VAL$WORD[2] = PTA$TN[PT];      # SET TERMINAL NAME             #
        END 
 
      ACC$TYP[0] = ACT$WORD[MTYP-1];   # MESSAGE TYPE TO ASSEMBLY AREA #
# 
*     BUILD VARIABLE PORTION OF ACCOUNT MESSAGE.
# 
      IF (MTYP EQ ABUN$) OR (MTYP EQ ABIC$) 
         OR (MTYP EQ ABER$) OR (MTYP EQ SIPI$)
      THEN                             # ABUN/ABIC/ABER/SIPI MESG      #
        BEGIN 
        ORDSBF = 0; 
        BITSBF = 36;
        END 
      ELSE                             # ABAP/AEAP/AEUN ACCOUNT MESSAGE#
        BEGIN 
        ORDSBF = 1; 
        BITSBF = 0; 
        END 
 
      IF (MTYP EQ ABER$) AND PTA$IFU[PT]
      THEN
        BEGIN 
        PTA$IFU[PT]=FALSE;
        VAL$WORD[0]=0;
        VAL$WORD[1]=0;
        END 
 
      TEMP = COMMA$;
      LEN  = 12;
      IF (MTYP EQ SIPI$)
      THEN
        BEGIN 
        TERMVAL = 0;
        END 
      ELSE
        BEGIN 
        TERMVAL = 2;
        END 
 
      FOR I = 0 STEP 1 UNTIL TERMVAL
      DO
        BEGIN 
        EBFNAME = VAL$WORD[I];
        EXTRACT;                       # EXTRACT NONZERO/NONBLANK CHAR #
# 
*       UPON RETURN FROM *EXTRACT*, A COMMA FOLLOWED BY ONE BLANK WILL
*       BE INSERTED INTO THE MESSAGE STREAM EXCEPT FOR THE LAST 
*       PARAMETER.  FOR THE LAST PARAMETER, A PERIOD FOLLOWED BY 12 
*       BITS OF ZERO IS INSERTED INTO THE MESSAGE STREAM INSTEAD. 
# 
        IF I EQ TERMVAL 
        THEN                           # LAST PARAMETER                #
          BEGIN 
          TEMP = PERIOD$; 
          LEN  = 24;
          END 
 
        SSBSBF(ACCMSG,ORDSBF,BITSBF,LEN,TEMP);
        END 
 
      MESSAGE(ACCMSG,5);               # MESSAGE TO ACCOUNT DAYFILE    #
# 
*     FOR ABAP AND AEAP AND AEUN FORM A SECOND LINE OF MESSAGE. 
# 
      IF (MTYP EQ ABAP$) OR (MTYP EQ AEAP$) OR (MTYP EQ AEUN$)
      THEN
        BEGIN 
        ACC$C2[0] = "C2"; 
        ORDSBF    = 1;
        BITSBF    = 0;
        IF (MTYP NQ AEUN$)
        THEN
        BEGIN 
          EBFNAME = PTA$SWTAPP[PT]; 
 
          EXTRACT;                     # EXTRACT NONBLANK CHARACTERS   #
        END 
# 
*       IF THE ABAP MESSAGE, INSERT A PERIOD AND ZERO BYTE TERMINATIOR. 
*       IF AEAP, INSERT COMMA AND BLANK AND CALL *NVFTCCT* TO CALCULATE 
*       APPLICATION CONNECT TIME, IF AEUN, CALL *NVFTCCT* TO CALCULATE
*       TERMINAL SESSION CONNECT TIME.
# 
        IF (MTYP EQ ABAP$)
        THEN                           # ABAP ACCOUNT MESSAGE          #
          BEGIN 
          TEMP = PERIOD$; 
          LEN  = 24;
          END 
        ELSE IF (MTYP EQ AEAP$)        # AEAP ACCOUNT MESSAGE          #
        THEN
          BEGIN 
          TEMP = COMMA$;
          LEN  = 12;
          SSBSBF(ACCMSG,ORDSBF,BITSBF,LEN,TEMP);
          CNTYP = TATIME$;
          NVFTCCT(PT,0,EBFNAME,CNTYP); # CALC APPL CONNECT TIME   # 
          EXTRACT;                     # EXTRACT NONBLANK CHARACTERS   #
          TEMP = SECS$; 
          LEN  = 48;
          END 
        ELSE
          BEGIN                        # AEUN ACCOUNT MESSAGE          #
          CNTYP=TSTIME$;
          NVFTCCT(PT,0,EBFNAME,CNTYP); # CALC TERMINAL SESSION CONN TIM#
          EXTRACT;
          TEMP=SECS$; 
          LEN=48; 
          END 
 
        SSBSBF(ACCMSG,ORDSBF,BITSBF,LEN,TEMP);
        MESSAGE(ACCMSG,5);             # MESSAGE TO ACCOUNT DAYFILE    #
        END 
 
CONTROL EJECT;
 
PROC EXTRACT; 
# TITLE EXTRACT - EXTRACT NONZERO AND NONBLANK CHARACTERS              #
 
      BEGIN  # EXTRACT #
# 
**    EXTRACT - EXTRACT NONZERO AND NONBLANK CHARACTERS.
* 
*     E. THAVIKULWAT    81/10/22
* 
*     THIS PROCEDURE IS INTERNAL TO PROCEDURE *NVFTIAM* AND IS CALLED 
*     ONLY BY *NVFTIAM*.  IT'S MAIN FUNCTION IS TO DELETE TRAILING
*     ZEROES AND BLANKS FROM NAMES AND STORE IT INTO ACCOUNT MESSAGE
*     ASSEMBLY AREA.
* 
*     PROC EXTRACT
* 
*     ENTRY:  
*       *EBFNAME* CONTAINS THE NAME, LEFT JUSTIFIED.
*       *ORDSBF*  CONTAINS THE STARTING WORD OF MESSAGE ASSEMBLY AREA 
*       *BITSBF*  CONTAINS STARTING BIT OF MESSAGE ASSEMBLY AREA
* 
*     EXIT: 
*       NAME WITHOUT TRAILING ZEROES AND BLANKS PACKED INTO ACCOUNT 
*       MESSAGE ASSEMBLY AREA.
* 
*     NOTES:  
*       MAXIMUM LENGTH OF NAME IS 20 DISPLAY CODED CHARACTERS.
* 
*     METHOD: 
*       CALL *SSBEBF* TO EXTRACT A 6-BIT CHARACTER.  IF NONZERO AND 
*       NONBLANK, CALL *SSBSBF* TO STORE IT INTO THE MESSAGE ASSEMBLY 
*       AREA. 
# 
 
      ITEM BITEBF     I;     # STARTING BIT OF NAME                    #
      ITEM ENDSRCH    B;     # EXIT LOOP VARIABLE                      #
      ITEM I          I;     # LOOP VARIABLE                           #
      ITEM ORDEBF     I;     # STARTING WORD OF NAME                   #
      ITEM TMPCHAR    I;     # TEMPORARY STORAGE AREA                  #
 
# 
*     INITIALIZE VARIABLES. 
# 
      ORDEBF  = 0;
      BITEBF  = 0;
      ENDSRCH = FALSE;
# 
*     EXTRACT AND STORE NONZERO/NONBLANK CHARACTERS.
# 
      FOR I = 0 STEP 1 WHILE (NOT ENDSRCH AND I LS 20)
      DO
        BEGIN 
        SSBEBF(EBFNAME,ORDEBF,BITEBF,6,TMPCHAR);
        IF (TMPCHAR EQ 0) OR (TMPCHAR EQ " ") 
        THEN
          BEGIN 
          ENDSRCH = TRUE; 
          END 
        ELSE
          BEGIN 
          SSBSBF(ACCMSG,ORDSBF,BITSBF,6,TMPCHAR); 
          END 
        END 
 
      END  # END EXTRACT #
 
      END  # END NVFTIAM #
 
TERM