         PCC      0                                                             
          SYSTEM   SIG5P                                                        
         SYSTEM   OPTIONS                                                       
         DEF      A:ESU                                                         
         DEF      ESUMXIT                                                       
         DEF      SEARCHAI,GETANAME                                             
         DEF      JMEXIT2,SAIEXIT                                               
OLAYFLAG EQU      'ESU'                                                         
         TITLE    '** ESU **'                                                   
*                                                                               
*                                                                               
OPENIT   CNAME    1                                                             
WRITE    CNAME    1                                                             
SETINDEX CNAME    1                                                             
READ     CNAME    1                                                             
CLOSEIT  CNAME    1                                                             
         PROC                                                                   
LF       CAL1,NAME AF(1)-TTTT,R7    POINT INTO TEMP SPACE                       
         PEND                                                                   
*                                                                               
*                                                                               
* PROC TO SIMPLIFY TYPE  OPERATIONS                                             
*                                                                               
TYPE     CNAME                                                                  
         PROC                                                                   
LF       LI,R13   AF(1)-TTTT                                                    
         AW,R13   R7                MAKE IT A PTR TO TEXTC                      
         AND,R13  M17               MASK OUT ADDR                               
         STW,R13  MSGPTR-TTTT,R7    PUT IN FPT                                  
         CAL1,2   FPT4-TTTT,R7      AND TYPE                                    
         PEND                                                                   
*                                                                               
         SYSTEM   CPRMON                                                        
         TITLE    '** ESU - ESUM KEY-IN **'                                     
* THIS TYPES  AN ERROR SUMMARY ON THE OC DEVICE                                 
*                                                                               
*                                                                               
ESU      RES      0                                                             
A:ESU    EQU      ESU                                                           
ESUM     RES      0                                                             
         LI,R1    2                 DEFAULT FOR TYPE                            
         CI,R6    2                 ANY FOLLOWING CHARACTERS                    
         BE       %+2               NO                                          
         LI,R1    1                 YES, SET FOR PRINT                          
         DO       #ERRORLOG                                                     
         LI,R6    DCT#IO                                                        
         BNEZ     %+2                                                           
         B        ESUMXIT           EXIT IF NO LOGGING SYSGENED                 
*                                                                               
         PUSH     R15                                                           
*                                                                               
         LI,R7    TEMPEND-TTTT      GET SPACE FOR FPT'S                         
         BAL,R8   GETTEMP           RETURN PTR IN R7                            
         B        STOPP             CANT GET SPACE                              
*                                                                               
         ENABLE                                                                 
         LI,R6    TEMPEND-TTTT-1    MOVE FPT'S TO TEMP SPACE                    
         LW,R0    TTTT,R6                                                       
         STW,R0   *R7,R6                                                        
         BDR,R6   %-2                                                           
*                                                                               
         LW,R0    FPT4-TTTT,R7      GET PRINT OR TYPE CODE                      
         STB,R1   R0                PUT IN NEW CODE                             
         STW,R0   FPT4-TTTT,R7      STORE NEW CODE                              
         PAGE                                                                   
* TYPE  OUT ERROR SUMMARY                                                       
*                                                                               
         LI,R6    1                 DCT INDEX CTR                               
*                                                                               
         LI,R1    X'1FFFF'          MASK                                        
         AND,R1   R7                GET TEMP ADDRESS                            
         AWM,R1   TIMEFPT-TTTT,R7   FIX UP FPT PTR                              
         CAL1,8   TIMEFPT-TTTT,R7   GET TIME                                    
*                                                                               
         TYPE     FILLER                                                        
         TYPE     TBUF                                                          
         TYPE     FILLER                                                        
         TYPE     CTRHEAD                                                       
         TYPE     FILLER                                                        
*                                                                               
ESUM10   RES      0                 LOOP ENTRY                                  
         LW,R0    DCTMOD,R6         MODEL #                                     
         STW,R0   CTRHEAD-TTTT+4,R7                                             
*                                                                               
         LD,R0    DCT16,R6          YYNDD                                       
         SCS,R0   -8                                                            
         LB,R0    R0                MASK LOW ORDER BYTE                         
         OR,R0    3BLANKS           OR IN BLANKS                                
         LCI      2                                                             
         STM,R0   CTRHEAD-TTTT+1,R7                                             
*                                                                               
          LI,R3    0                                                            
          MTW,0    DCT#IO,R6                                                    
          BEZ      ESUM20            DONT COMPUTE RATE IF NO ACCESSES           
*                                                                               
          LW,R3    DCT#ERR,R6                                                   
          MI,R3    1000                                                         
          DW,R3    DCT#IO,R6         ERRORS/1000 INTO R3                        
*                                                                               
ESUM20    BAL,R0   CONVERT2          CONVERT TO EBCDIC                          
          LCI      2                                                            
          STM,R2   CTRHEAD-TTTT+12,R7 PUT IN MESSAGE                            
*                                                                               
         LW,R3    DCT#ERR,R6        ERROR COUNT                                 
         BAL,R0   CONVERT2          CONVERT TO EBCDIC                           
         LCI      2                                                             
         STM,R2   CTRHEAD-TTTT+9,R7                                             
*                                                                               
         LW,R3    DCT#IO,R6         ACCESSES                                    
         BAL,R0   CONVERT2                                                      
         LCI      2                                                             
         STM,R2   CTRHEAD-TTTT+6,R7                                             
*                                                                               
         TYPE     CTRHEAD                                                       
*                                                                               
         LW,R2    K:CTST                                                        
         CW,R2    Y04               WAS INTERRUPT BUTTON PUSHED                 
         BANZ     ESUM30            IF SO, STOP AND PRINT LOG LINE              
*                                                                               
         AI,R6    1                                                             
         CH,R6    DCT1              CHECK AGAINST DCT COUNT                     
         BLE      ESUM10            IF LESS, LOOP                               
*                                                                               
ESUM30   LW,R3    GOODLOGS          TOTAL LOGS                                  
         BAL,R0   CONVERT2                                                      
         LCI      2                                                             
         STM,R2   LOGMSG-TTTT+1,R7                                              
*                                                                               
         LW,R3    LOSTLOGS          LOST LOGS                                   
         BAL,R0   CONVERT2                                                      
         LCI      2                                                             
         STM,R2   LOGMSG-TTTT+6,R7                                              
*                                                                               
         TYPE     FILLER                                                        
         TYPE     LOGMSG                                                        
         TYPE     FILLER                                                        
*                                                                               
         BAL,R8   RELTEMP           RELEASE TEMP SPACE                          
*                                                                               
*                                                                               
STOPP    PULL     R15                                                           
         FIN      #ERRORLOG                                                     
ESUMXIT   B        *R15              AND EXIT                                   
**************************************                                          
         TITLE    '** ESU - SUBROUTINES **'                                     
*                                                                               
* CONVERT - THIS ROUTINE CONVERTS A VALUE IN R3 TO EBCDIC IN R2/3               
*                                                                               
* NO REGISTERS ARE ALTERED AND THE LINK IS R0                                   
*                                                                               
CONVERT  RES      0                                                             
         PUSH     3,R4              SAVE WORKING SPACE                          
         LI,R6    7                 STORE INDEX                                 
         LW,R5    R3                DATA TO CONVERT                             
CLOOP    LI,R4    0                                                             
         DW,R4    TEN               REMAINDER TO R4, Q TO R5                    
         AI,R4    '0'               ADD IN ZONE                                 
         STB,R4   R2,R6             AND STORE IN RESULT                         
         AI,R6    -1                                                            
         BGEZ     CLOOP             LOOP TILL DONE                              
         PULL     3,R4              RESTORE REGISTERS                           
         B        *R0                                                           
*                                                                               
TEN      DATA     10                                                            
*                                                                               
         PAGE                                                                   
*                                                                               
* CONVERT2 - THIS ROUTINE IS THE SAME AS CONVERT, BUT FILLER                    
* LEADING ZEROS                                                                 
*                                                                               
CONVERT2 RES      0                                                             
         PUSH     2,R0                                                          
         BAL,R0   CONVERT                                                       
         LI,R1    7                 COUNTER                                     
CLOOP2   LB,R0    R2                PICK UP A BYTE                              
         CI,R0    '0'               IS IT A ZERO                                
         BNE      CONVERT3          NO, FINISH UP                               
         LI,R0    ' '               PICK UP A BLANK                             
         STB,R0   R2                AND BLANK CHARACTER                         
         SCD,R2   8                 SHIFT EBCDIC                                
         BDR,R1   CLOOP2            AND LOOP TIL DONE                           
         SCD,R2   8                                                             
CONVERT4 PULL     2,R0              RESTORE REGISTERS                           
         B        *R0                                                           
************************************                                            
CONVERT3 RES      0                                                             
         AI,R1    1                                                             
         SLS,R1   3                 TIMES 8                                     
         SCD,R2   0,R1              POSITION EBCDIC                             
         B        CONVERT4          AND EXIT                                    
*                                                                               
*                                                                               
3BLANKS  DATA     X'40404000'                                                   
*                                                                               
         TITLE    '** ESU - FPT DEFINATIONS **'                                 
*                                                                               
FPT      COM,8,24 AF(1),AF(2)                                                   
*                                                                               
TTTT     RES      1                                                             
*                                                                               
FPT4     FPT      2,0               FPT TO TYPE  MESSAGES                       
         DATA     P1+F3                                                         
MSGPTR   DATA     0                 MESSAGE PTR                                 
*                                                                               
TIMEFPT  FPT      X'10',TBUF+1-TTTT                                             
*                                                                               
TBUF     TEXTC    '   TIME UNKNOWN     '                                        
*                                                                               
         TITLE    '** ESU - MESSAGES **'                                        
*                                                                               
*                                                                               
CTRHEAD  TEXTC    '      YYNDD    MDL#    ACCESSES      ERRORS',;               
                   '    ERR/1000'                                               
*                                                                               
LOGMSG   TEXTC    '   XXXXXXXX FILED LOGS,XXXXXXXX LOGS LOST'                   
*                                                                               
FILLER   TEXTC    ' '                                                           
*                                                                               
TEMPEND  RES      0                                                             
         TITLE    '** ESU - SEARCH AI FILE **'                                  
*                                                                               
*        A C C O U N T   I N V E N T O R Y   F I L E   S E A R C H              
*                                                                               
*                                                                               
*                 THIS ROUTINE PERFORMS A BINARY SEARCH ON                      
*                 THE  AI  FILE  IN  THE  SP  AREA.                             
*                                                                               
*                                                                               
*        CALL:                                                                  
*                                                                               
*        BAL,R8   SEARCHAI                                                      
*        *        RETURN HERE IF INVALID ACCOUNT/NAME  R15=TYC                  
*        *        RETURN HERE IF GOOD ACCOUNT/NAME                              
*        BOTH RETURNS HAVE CLOBBERED R0                                         
*                                                                               
*        AT CALL:                                                               
*                 R10    ACCOUNT                                                
*                 R11    ACCOUNT  LEFT JUSTIFIED BLANK FILLED                   
*                                                                               
*                 R12    NAME                                                   
*                 R13    NAME                                                   
*                 R14    NAME LEFT JUSTIFIED BLANK FILLED                       
*                                                                               
*                                                                               
SEARCHAI EQU      %                                                             
         PUSH     11,R1             SAVE REGS (R1-R11)                          
         PUSH     2,R10             SAVE ACCOUNT                                
         LI,R7    32                SETUP TO ACQUIRE WORK SPACE                 
         BAL,R8   GETTEMP                                                       
         B        SAI11             NONE                                        
         PULL     2,R10             GET ACCOUNT BACK                            
         BAL,R8   TISCHN            CHAIN IT UP                                 
         LI,R0    8                 SWITCH                                      
         LI,R1    0                 CHARACTER INDEX                             
         AND,R7   M17                                                           
         AI,R7    ANAME             OFFSET TO ACCOUNT/NAME/COMMA DATA           
         LI,R2    0                                                             
         LI,R6    R10                                                           
SAI01    EQU      %                                                             
         LB,R8    *R6,R2            GET BYTE                                    
         CI,R8    ' '               IS IT A BLANK                               
         BE       SAI02             B IF YES                                    
         STB,R8   *R7,R1            STORE IN WORK AREA                          
         AI,R1    1                 MOVE INDEX                                  
         AI,R2    1                 MOVE INDEX                                  
         BDR,R0   SAI01             GO FOR MORE                                 
SAI02    CI,R6    R12               DONE YET                                    
         BE       SAI03             B IF YES                                    
         LI,R6    R12               SETUP FOR NAME FIELD                        
         LI,R0    ','                                                           
         STB,R0   *R7,R1            STORE A COMMA                               
         AI,R1    1                                                             
         LI,R2    0                                                             
         LI,R0    12                                                            
         B        SAI01             GO FOR MORE                                 
SAI03    EQU      %                                                             
         STW,R7   ANAMEAD-ANAME,R7  SAVE ADDRESS OF ACC/NAME/COMMA              
         AI,R7    -ANAME            RESTORE TEMP SPACE ADDRESS                  
         STW,R1   CCOUNT,R7         SAVE TOTAL BYTE COUNT                       
         LI,R1    SAITLENG                                                      
SAI04    LW,R0    SAIPROTO,R1                                                   
         LB,R2    SAIPADJ,R1                                                    
         EXU      SAINST,R2         BIAS TO WORK SPACE                          
         STW,R0   *R7,R1                                                        
         BDR,R1   SAI04                                                         
         LCI      4                                                             
         LM,R1    OPENFPT           NOW SETUP TO DO FILE OPEN                   
         AW,R1    R7                DCB ADDRESS                                 
         CAL1,1   R1                OPEN                                        
         LI,R5    7                                                             
         LB,R5    *R1,R5            GET RECORD SIZE OF FILE                     
         LW,R5    RFT6,R5                                                       
         STW,R5   FINALREC,R7       SIZE IS FINAL RECORD INDEX                  
         BEZ      EQUALS            A NULL FILE IS A GOOD ACCOUNT               
         AI,R5    RECINBLK-1        NOW ANALYSE BLOCK COUNT                     
         DW,R5    SHAI1                                                         
         LI,R4    31                                                            
         SLS,R5   1                 SHIFT TO FINAL COVERING POWER               
         BOV      %+2               OUT IF 1 BIT ENCOUNTERED                    
         BDR,R4   %-2                                                           
         STB,R4   R4                                                            
         STW,R4   POWERS,R7         SET COVERING POWER OF TWO                   
         LI,R1    0                 SET TO INITIAL RECORD                       
         STW,R1   SAIWORK,R7                                                    
         LI,R1    -RECINBLK+1       COMPENSATION                                
         LI,R4    1                 AND INCREMENT TO MIDDLE POWER               
         LW,R8    REWAI             SETUP TO REWIND FILE                        
         AW,R8    R7                DCB ADDRESS                                 
         CAL1,1   R8                REWIND IT                                   
         B        BUMPIT                                                        
*                                                                               
SHAI1    DATA     RECINBLK                                                      
         PAGE                                                                   
READBLK  LI,R4    0                 GET A BLOCK OF RECODS                       
         CW,R1    FINALREC,R7       IF NOT OVER END-OF-FILE                     
         BG       BUMPIT            YES - MOVE BACK IN FILE                     
         LI,R0    0                                                             
         STW,R0   BLOCKSZ,R7                                                    
         LW,R15   FINALREC,R7       TEST IF IN FINAL BLOCK                      
         SW,R15   R1                                                            
         CI,R15   RECINBLK                                                      
         BGE      %+4               FORWARD IF NOT LAST BLOCK                   
         AI,R15   1                 LAST BLOCK, SET WORD COUNT                  
         MI,R15   RECWORDS                                                      
         STW,R15  BLOCKSZ,R7                                                    
         LI,R5    1                                                             
         LW,R0    R1                FIND FILE DISPLACEMENT                      
         SW,R0    SAIWORK,R7                                                    
         BGEZ     %+4                                                           
         LW,R0    SAIWORK,R7                                                    
         SW,R0    R1                                                            
         LI,R5    0                                                             
         STW,R1   SAIWORK,R7        SET RECORD INDEX                            
         EXU      ADJUST1,R5                                                    
         STW,R0   PRECFPT+2,R7                                                  
         LW,R0    ADJUST2,R5        SET DIRECTION OF DISPLACEMENT               
         STW,R0   PRECFPT+1,R7                                                  
         CAL1,1   PRECFPT,R7                                                    
         CAL1,1   READFPT,R7        READ IN BLOCK                               
*                                                                               
*                                                                               
         LW,R1    SAIWORK,R7        SET RECORD INDEX READ                       
         LI,R5    7                                                             
         LI,R0    AIDCB                                                         
         AW,R0    R7                                                            
         LB,R5    *R0,R5            GET FILE INDEX                              
         LW,R5    RFT17,R5          THEN BLOCKING BUFFER ADDRESS                
         LW,R5    *R5                                                           
         AND,R5   M17                                                           
         LW,R0    ANAMEAD,R7                                                    
         LI,R4    0                                                             
COMPARE  LI,R2    0                 CRITERION WORD COUNT                        
COMP1    LB,R10   *R0,R2                                                        
         CB,R10   *R5,R2            MAKE COMPARISON                             
         EXU      GREATER,R4        OUT ON GREATER THAN                         
         EXU      LESSTHAN,R4       OUT ON LESS THAN                            
         AI,R2    1                                                             
         CW,R2    CCOUNT,R7                                                     
         BL       COMP1             LOOP ON EQUAL AND MORE TO TEST              
         LB,R10   *R5,R2                                                        
         CI,R10   ' '               BLANK                                       
         BE       EQUALS            B IF BOTH STRINGS ENDED                     
         LW,R10   LESSTHAN,R4       EXIT IF GIVEN STRING LESS                   
         B        *R10                                                          
*                                                                               
*                                                                               
GREATER  BG       PHASE1                                                        
         BG       BUMPIT                                                        
         BG       PHASE22                                                       
LESSTHAN BL       BUMPIT                                                        
         BL       PHASE2                                                        
         BL       NOSHOW                                                        
ADJUST   SW,R1    R5                                                            
         AW,R1    R5                                                            
ADJUST1  AI,R0    1                                                             
         AI,R0    -1                                                            
ADJUST2  DATA     P1+P2+F3+F4                                                   
         DATA     P1+P2+F4                                                      
*                                                                               
*                                                                               
PHASE2   LI,R3    (RECINBLK-1)*RECWORDS                                         
         STW,R3   BLOCKSZ,R7                                                    
         SW,R5    R3                                                            
PHASE21  AI,R4    1                                                             
PHASE22  LW,R3    BLOCKSZ,R7                                                    
         AI,R3    -RECWORDS                                                     
         BEZ      NOSHOW            OUT IF ALL OF BLOCK TESTED                  
         STW,R3   BLOCKSZ,R7                                                    
         AI,R5    RECWORDS                                                      
         B        COMPARE                                                       
*                                                                               
PHASE1   LI,R4    1                                                             
         LW,R3    BLOCKSZ,R7                                                    
         BNEZ     PHASE21                                                       
         AI,R5    (RECINBLK-1)*RECWORDS                                         
         B        COMPARE                                                       
BUMPIT   LW,R5    POWERS,R7         ADJUST BY NEXT POWER OF TWO                 
         LB,R2    R5                                                            
         BEZ      NOSHOW                                                        
         AI,R2    -1                                                            
         STB,R2   R5                                                            
         STW,R5   POWERS,R7                                                     
         LI,R5    RECINBLK                                                      
         SLS,R5   0,R2                                                          
         EXU      ADJUST,R4                                                     
         B        READBLK                                                       
EQUALS   LI,R15   TYCNORM                                                       
         B        %+2               ACCOUNT HAS BEEN FOUND                      
NOSHOW   LI,R15   TYC7B             ACCOUNT HAS NOT BEEN FOUND                  
         LCFI     4                 PICKUP OPEN FPT                             
SAI09    EQU      %                                                             
         LM,R8    CLOSEFPT                                                      
         AW,R8    R7                FORM DCB ADDRESS                            
         CAL1,1   R8                CLOSE THE FILE                              
SAIER04  EQU      %                                                             
         BAL,R8   TISDECHN          NOW GET RID OF TEMP SPACE                   
         BAL,R8   RELTEMP           RELEASE IT                                  
SAI10    EQU      %                                                             
         PULL     11,R1                                                         
         CI,R15   TYCNORM           WAS THE SEARCH SUCESSFUL                    
         BNE      %+2               B IF NO                                     
         AI,R8    1                 TAKE GOOD EXIT                              
SAIEXIT  B        *R8               RETURN                                      
SAI11    EQU      %                                                             
         PULL     2,R10             JUST BALANCE STACK                          
         B        SAI10             AND RETURN                                  
*                                                                               
****                                                                            
SAIER01  EQU      %                                                             
SAIER02  EQU      %                                                             
         LB,R15   R10               GET ERROR CODE                              
         B        SAI09             AND GO CLOSE THE FILE                       
**********                                                                      
SAIER03  EQU      %                                                             
         LB,R15   R10               GET ERROR CODE                              
         CI,R15   TYC03             IS IT NON EXISTANT FILE                     
         BNE      SAIER04           NO  -  SOME KINK OF ERROR                   
         LI,R15   TYCNORM           A NON-EXISTANT AI FILE                      
         B        SAIER04           MEANS ALL ACCOUNTS ARE GOOD                 
**********                                                                      
         PAGE                                                                   
RECWORDS EQU      20                AI WORDS PER RECORD - 80 BYTES              
RECINBLK EQU      256/RECWORDS      #OF RECORDS IN BLOCK                        
*********                                                                       
SAINST   EQU      %                                                             
         NOP                                                                    
         AW,R0    R7                BIAS IT                                     
*************                                                                   
SAIPROTO EQU      %                                                             
         DATA     0                 DUMMY                                       
         GEN,8,24 7,1               AI DCB                                      
         GEN,8,24 5,0               *                                           
         DATA     0,0,0             *                                           
         TEXT     'AI      '        *                                           
*                                                                               
         GEN,8,24 X'10',AIDCB       READ FPT                                    
         DATA     P1+P2+P3+P4+F3    *                                           
         DATA     SAIER01,SAIER01   *                                           
         DATA     SAIBUFF           *                                           
         DATA     1                 *                                           
*                                                                               
         GEN,8,1,23  X'1D',1,AIDCB  PREC FPT                                    
         DATA     P1+P2+F4                                                      
         DATA     0                                                             
         DATA     SAIER02                                                       
*                                                                               
SAIPEND  EQU      %                                                             
SAITLENG EQU      SAIPEND-SAIPROTO-1                                            
SAIPADJ  EQU      %                                                             
         DATA,1   0                 DUMMY                                       
         DATA,1   0,0,0,0,0,0,0     DCB ADJ.                                    
         DATA,1   1,0,0,0,1,0       READ FPT ADJ                                
         DATA,1   1,0,0,0           PREC FPT ADJ                                
         BOUND    4                                                             
*******************                                                             
AIDCB    EQU      1                                                             
READFPT  EQU      8                                                             
PRECFPT  EQU      14                                                            
FINALREC EQU      18                                                            
POWERS   EQU      19                                                            
BLOCKSZ  EQU      20                                                            
CCOUNT   EQU      21                                                            
SAIWORK  EQU      22                                                            
ANAMEAD  EQU      23                                                            
SAIBUFF  EQU      24                                                            
ANAME    EQU      26                                                            
*                                                                               
OPENFPT  EQU      %                                                             
         GEN,8,24 X'14',AIDCB                                                   
         DATA     P1+P2                                                         
         DATA     SAIER03,SAIER03                                               
*                                                                               
CLOSEFPT EQU      %                                                             
         GEN,8,24 X'15',AIDCB                                                   
         DATA     P1+P2                                                         
         DATA     SAIER04,SAIER04                                               
*                                                                               
REWAI    EQU      %                                                             
         GEN,8,24 1,AIDCB                                                       
*******************                                                             
         TITLE    '** ESU - GET ACCOUNT NAME FOR STANDARD FPT **'               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*        CALL:                                                                  
*                 BAL,R8   GETANAME                                             
*                 R3 HAS FPT ADDRESS                                            
*                                                                               
*                 R3=0  (NO FPT)  R10-R14 HAVE ACCOUNT AND NAME                 
*                                                                               
*                                                                               
*        ROUTINE DEFAULTS BOTH ACCOUNT AND USER NAME                            
*        ROUTINE CALLS SEARCHAI TO VERIFY NON-DEFAULTED PARAMETERS              
*                                                                               
*        AT EXIT:                                                               
*                                                                               
*                 R10 AND R11 HAVE ACCOUNT                                      
*                 R12,R13,R14 HAVE USER NAME                                    
*                                                                               
*                                                                               
*                                                                               
GETANAME EQU %                                                                  
         PUSH     8,R1              SAVE REGS                                   
         LB,R6    TCBPOINT                                                      
         LB,R6    STIJID,R6                                                     
         LW,R6    SJI1,R6           R6 HAS JCB ADDRESS                          
         LI,R1    0                 SWITCH                                      
         CI,R3    0                 ANY FPT SUPPLIED                            
         BNE      JMX000                                                        
         LI,R8    R10               POINTS TO SUPPLIED INFO                     
         B        JMX00                                                         
JMX000   EQU      %                                                             
         LI,R15   FPTANAME          SETUP TO VERIFY ACCOUNT AND NAME            
         BAL,R5   GETPSII                                                       
         B        JMX08             PARAMETER ABSENT DEFAULT                    
         LW,R8    R14                                                           
JMX00    EQU      %                                                             
         LCI      2                                                             
         LM,R10   *R8               GET ACCOUNT NAME                            
         CD,R10   BLANKS            DEFAULTED                                   
         BNE      JMX06             B IF NO                                     
JMX01    EQU      %                 HERE TO DEFAULT ACCOUNT NAME                
         LCI      2                                                             
         LM,R10   JCBACCNT,R6       FETCH ACCOUNT                               
         AI,R1    1                                                             
JMX02    EQU      %                 HERE TO TEST NAME INFO                      
         AI,R8    2                 MOVE POINTER TO NAME FIELD                  
         LCI      3                                                             
         LM,R12   *R8               GET NAME AND CHECK IF                       
         CD,R12   BLANKS            IT IS TO BE DEFAULTED                       
         BNE      JMX05                                                         
         CW,R13   BLANKS                                                        
         BNE      JMX05                                                         
JMX03    EQU      %                 HERE TO DEFAULT NAME                        
         AI,R6    2                 MOVE POINTER TO NAME FIELD                  
         LCI      3                                                             
         LM,R12   JCBACCNT,R6       GET DEFAULT USER NAME                       
         AI,R1    1                                                             
JMX04    EQU      %                                                             
         LI,R15   TYCNORM                                                       
         CI,R1    2                 WAS ANYTHING NOT DEFAULTED                  
         BE       JMX07             B IF NO                                     
         BAL,R8   SEARCHAI          VERIFY THE ACCOUNT/NAME                     
         B        JMX07             OUT ON BAD ACCOUNT/NAME                     
         B        JMX07             GOOD                                        
*                                                                               
JMX05    EQU      %                                                             
         CD,R12   ZEROS             DEFAULTED                                   
         BNE      JMX04             B IF NO                                     
         CW,R14   ZEROS             DEFAULTED                                   
         BNE      JMX04             B IF NO                                     
         B        JMX03             DEFAULT NAME                                
*                                                                               
JMX06    EQU      %                                                             
         CD,R10   ZEROS             DEFAULTED                                   
         BNE      JMX02             B IF NO                                     
         B        JMX01             B IF YES                                    
*                                                                               
JMX07    EQU      %                                                             
         PULL     8,R1              RESTORE REGISTERS                           
         CI,R15   TYCNORM           EVERYTHING ALLRIGHT                         
JMEXIT1  EQU      %                                                             
         BNE      JMEXIT2           B IF ERROR                                  
         AI,R8    1                 TAKE GOOD EXIT                              
JMEXIT2  EQU      %                                                             
         B        *R8               R10,11 HAVE ACCOUNT                         
JMX08    EQU      %                                                             
         LCI      5                                                             
         LM,R10   JCBACCNT,R6       DEFAULT EVERYTHING                          
         LI,R15   TYCNORM                                                       
         B        JMX07                                                         
*                                   R12,13,14 HAVE NAME                         
*                                                                               
*                                                                               
         OLAYEND                                                                
*                                                                               
         END                                                                    
