BLDCB    DSECT    1
PLSECT   CSECT    1
         PAGE
VERSION  EQU      2                 1=BPM, 2=UTS
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU       12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
         TITLE    'BLDCB'
         SYSTEM   SIG7
*
* BLDCB           BUILD DCB
*
* INPUT
*        R1       BIT 12   TEST FILE
*                 BIT 28   INOUT MODE FLAG(0-NOT INOUT,1-INOUT MODE)
*                 BIT 29   NXTF FLAG (0-NOT NXTF,1-NXTF)
*                 BIT 30   FPARAM FLAG (0-NOT FPARAM,1-FPARAM)
*                 BIT 31   I/O SWITCH (0-INPUT,1-OUTPUT)
*        ARGTBL   TABLE OF TRANSLATED ARGUMENTS (DEVICE FILE,MODE)
*        NCHAR    LENGTH OF CURRENT ARGUMENT IN -ARGBUFF-
*        TOVER    OUTPUT VERB
* OUTPUT
*        M:EI     INPUT DCB
*        M:EO     OUTPUT DCB
*        OPNFPT   OPEN FILE PARAMETER TABLE
*        DCBADD   ADDRESS OF CURRENT DCB (M:EI,M:EO OR M:STD)
*        CMBX     COMMAND BUFFER INDEX
*
         DEF      VLPOPEN
*
         REF      GETARG,STORVLP,ERROR,CALL1
         REF      ARGTBL,DEVICE,FILE,MODE
         REF      NCHAR,DCBADD,CMBX
         REF      OPNFPT,FPARAM
         REF      CLOSEO,TOVER,M:UC
         REF      J:JIT
         REF      CODE
         REF      TLBLSIZE
         REF      SEQUENCE
         REF      TOARG
         REF      #DELIM
         REF      SFACCT
         REF      COPYSTDF,ARGBUF4,TLABEL
         REF      LINENO
         REF      RDTBL,WRTBL
         REF      EXTBL,UNTBL
         REF      DENSITY
         REF      CLOSEI
         REF      SFTEMP
         REF      SCRATCH,PRTBUF
         REF      ARGBUFF
         REF      FROMFILE
        REF      PRNTBUF
         REF      COPYPHY
         REF      FROMCMBX
         REF      UNPRINT
         DEF      ADDFILEN
*
         DEF      MAXSN
         REF      ANSBLK
         REF      SIXPACK
         REF      EXPIRE
         REF      DEV%IN,DEV%OUT
         REF      DEV%SAV1
         REF      IN%ARG,OUT%ARG
         USECT    BLDCB
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
*
         LW,SR2   R1                SAVE I/O SWITCH
*
         LW,R6    DEVICE,R7         INITIALIZE FOR DEFAULT TABLE SEARCH
         MTW,0    J:JIT
         BLZ      DEFAULT4          ON-LINE
         CI,R6    8                 IS 'ME' USED IN BATCH
         BNE      DEFAULT5          NO
         LI,R6    1                 CHANGE TO 'CR' FOR INPUT
         CI,SR2   1
         BAZ      %+2               INPUT
         LI,R6    9                 CHANGE TO 'LP' FOR OUTPUT
         STW,R6   DEVICE,R7         RESET DEVICE CODE
         B        DEFAULT5
DEFAULT4 EQU      %
         CI,R6    1                 IS 'CR' USED ON-LINE
         BNE      DEFAULT5          NO
         LI,R6    8                 CHANGE 'CR' TO 'ME'
         STW,R6   DEVICE,R7
DEFAULT5 EQU      %
         AI,R6    0
         BNEZ     DEFAULT7
         LW,R6    DEV%IN,R7
         CI,SR2   1            CHECK FOR INPUT.
         BAZ      %+2          INPUT.
         LW,R6    DEV%OUT,R7   LOAD SYSTEM OUTPUT DEVICE.
DEFAULT7 EQU      %
         STW,R6   DEV%SAV1,R7  SAVE DEVICE CODE.
         AI,R6    0
         BEZ      DEFAULT8     NO DEVICE--SYSTEM OP LABEL.
         CI,SR2   1
         BAZ      %+2               INPUT
         AI,R6    6                 INC FOR OUTPUT DEVICE CODE
         LI,SR3   0                 INITIALIZE FOR VLPS
         LI,R1    6
*
DEFAULT1 LW,R2    DEFAULT-1,R1      TEST FOR DEFAULT FLAG
         SLS,R2   -1,R6
         CI,R2    0
         BGE      DEFAULT2
*
         LI,R2    X'7FFF'           GET DEFAULT VAL AND ARGTBL LOC
         AND,R2   DEFAULT-1,R1
         SLD,R2   -8
         SLS,R3   -24
         AI,R3    ARGTBL+ARGTBL+ARGTBL+ARGTBL
         LB,R4    *R7,R3            SET DEFAULT IF ARGTBL VALUE ZERO
         BNEZ     DEFAULT2
         STB,R2   *R7,R3
DEFAULT2 BDR,R1   DEFAULT1
*
DEFAULT8 EQU      %
         LW,R6    DEV%SAV1,R7  RESTORE DEVICE CODE.
         LI,R1    OPENSIZE          INITIALIZE OPEN FPT
         LW,R2    R7
         AI,R2    OPNFPT-1
         LW,R3    IOPNFPT-1,R1
         STW,R3   *R2,R1
         BDR,R1   %-2
*
         CI,R6    7                 TEST IF ANS TAPE
         BNE      DEFAULT6          NO
         STW,R0   OPNFPT+9,R7
         STW,R0   OPNFPT+10,R7  ZERO FPARAM AND TLABEL FOR ANS.
         B        %+3
DEFAULT6 EQU      %
         LI,R1    TLABEL
         STW,R1   OPNFPT+10,R7   PUT TAPE FILE LABEL BUF ADR IN DCB.
         DO       VERSION=2
         LW,R3    =X'80000'
         LW,R2    SR2
         STS,R2   OPNFPT,R7         SET TESTFILE BIT IF PRESENT
         FIN
*
         CI,SR2   1                 INPUT MODE
         BANZ     DEFAULT3          NO
         CI,SR2   4                 OPEN NEXT ON INPUT
         BANZ     ADDRN             YES-KEEP NO PASSWORD ENTRY
DEFAULT3 EQU      %
         LW,R1    =X'02000002'
         STW,R1   VLPOPEN+9,R7      MAKE A LIVE PASS WORD VLP ENTRY
ADDRN    LW,R5    DEVICE+1,R7       TEST FOR REEL NO.S
         BNEZ     ADDRN3            PRESENT
         LW,R2    SCRATCH,R7        IS SCRATCH TAPE IN USE
         BEZ      ADDFILE           NO
         LI,R5    1                 INDICATE ONE SER NO
         CI,R6    4
         BE       ADDRN5            LT
         CI,R6    6                 TEST FOR FT
         BE       ADDRN5            YES
         CI,R6    12                REW OR REM
         BNE      ADDFILE           NO
ADDRN5   SLD,R2   -8
         STW,R2   ARGBUFF,R7        PUT SN IN ARG BUFFER
         STW,R3   ARGBUFF+1,R7
         B        ADDRN4
ADDRN3   EQU      %
         CI,R6    3
         BE       ADDFILE           STD FILE INPUT
         LW,R1    DEVICE+2,R7       SET CMBX FOR FIRST REEL NO.
         STW,R1   CMBX,R7
ADDRN1   EQU      %
         LI,R1    6                 ENABLE # DELIMITER
         CI,R6    7                 IS DEVICE ANS TAPE
         BNE      ADDRN6            NO
         LI,R1    12                ALLOW OPTIONAL CHAR STRING
ADDRN6   STW,R1   #DELIM,R7         SET DELIMITER MODE
         BAL,SR4  GETARG            GET REEL NO. ARGUMENT
         LW,R2    NCHAR,R7          TEST FOR NULL ARGUMENT
         BEZ      ADDRN2
         CI,R6    7                 IS DEVICE ANS TAPE
         BNE      ADDRN4            NO
         LW,R1    R7
         SLS,R1   2
         AI,R1    ARGBUF4+1         BYTE ADR OF SER NO
         BAL,SR4  SIXPACK           GO HASH 6-CHAR SN
         AI,R4    0                 IS SN VALID
         BE       ADDRN5            YES
         LI,R1    3                 INVALID REEL NUMBER SPEC
         B        ERRTN
ADDRN4   EQU      %
         LI,R1    4                 SN=4
         BAL,SR4  STORVLP
ADDRN2   BDR,R5   ADDRN1
*
ADDFILE  LI,R5    1
         CI,SR2   1
         BAZ      ADDFILEM          INPUT MODE
         MTW,0    COPYSTDF,R7
         BNEZ     ADDFILED          COPYSTD OUTPUT
ADDFILEM EQU      %
         LW,R1    FILE+1,R7         TEST FOR FILE ARGUMENTS
         BEZ      ADDOPL
ADDFILEB EQU      %
         STW,R1   CMBX,R7           SET CMBX OF FILE NAME
*
ADDFILE1 LI,SR4   ADDFILEF
ADDFILEN PSW,SR4  *R7
         LI,R1    12
         STW,R1   #DELIM,R7         SET DELIM MODE FOR FILE ID
         LW,R1    CMBX,R7
         STW,R1   LINENO,R7         SAVE ARGUMENT POINTER
         CI,R1    SFTEMP+SFTEMP+SFTEMP+SFTEMP
         BNE      ADDFILEG
         LW,R1    SFTEMP,R7         PUT TEMP FILE NAME IN ARG BUFFER
         STW,R1   ARGBUFF,R7
         LI,R1    2
         STW,R1   NCHAR,R7          SET NO OF CHAR
         B        ADDFILE9
ADDFILEG EQU      %
         BAL,SR4  GETARG            GET ARGUMENT
         BCS,1    ADDFILE9          CHAR STRING
         MTW,0    NCHAR,R7
         BEZ      ADDFILE9          NULL FIELD
         LI,R1    ARGBUF4+1
         LB,R6    *R7,R1
         CI,R6    X'E7'             IS FIRST CHAR AN X
         BNE      ADDFILE9          NO
         AI,R1    1
         LB,R6    *R7,R1
         CI,R6    X'7D'             ARE FIRST 2 CHARS X'
         BNE      ADDFILE9          NO
         LI,R2    ARGBUF4+1         DESTINATION INDEX IN ARGBUFF
         LW,R3    NCHAR,R7
         AI,R3    -3                NO. CHARS TO MOVE
         LI,R1    ARGBUF4+3         SOURCE INDEX IN ARGBUFF
         LI,SR4   1
         CI,R3    1                 IF ODD NUMBER OF HEX DIGITS
         BANZ     ADDFILE5+1        MOVE ONLY ONE THE FIRST TIME
ADDFILE5 LI,SR4   2                 2 DIGITS PER BYTE
         LI,R4    0
ADDFILE6 SLS,R4   4                 SHIFT DIGIT
         LB,R6    *R7,R1            GET HEX CHAR
         AI,R1    1                 POSITION INDEX TO NEXT CHAR
         CI,R6    X'F9'             IS CHAR VALID
         BG       FIDERR            NO
         CI,R6    X'F0'
         BGE      ADDFILEA          OK - 0-9
         CI,R6    X'C6'
         BG       FIDERR            INVALID
         CI,R6    X'C1'
         BL       FIDERR            INVALID
         AI,R6    9                 CONVERT A-F
ADDFILEA AND,R6   =X'F'
         OR,R4    R6                COMBINE DIGITS
         BDR,R3   ADDFILE8          LOOP ON NO. OF HEX DIGITS
         STB,R4   *R7,R2            STORE LAST BYTE
         LI,R1    X'40'
         LI,R3    7
         AI,R2    1
         STB,R1   *R7,R2            BLANK FILL TO RIGHT
         BDR,R3   %-2
         B        ADDFILE7
ADDFILE8 BDR,SR4  ADDFILE6
         STB,R4   *R7,R2            STORE BYTE
         AI,R2    1                 POSITION TO NEXT DEST BYTE
         B        ADDFILE5
FIDERR   LI,R1    3
         AW,R1    R5                ERROR CODE 4,5, OR 6
         BAL,SR4  ERROR
         PLW,SR4  *R7
         CI,SR4   ADDFILEF          ENTERED FROM REVIEW
         BNE      *SR4              YES - EXIT
         B        RETURN            EXIT
ADDFILE7 AI,R2    -ARGBUF4-7        NEW LENGTH
         STW,R2   NCHAR,R7
         LI,R1    ARGBUF4
         STB,R2   *R7,R1            PUT NEW LENGTH IN ARGBUFF
ADDFILE9 EQU      %
         PLW,SR4  *R7
         B        *SR4
ADDFILEF EQU      %
         AI,SR3   0                 RD OR WR ACCOUNTS
         BNEZ     ADDOPL5           YES
*
         LW,R2    NCHAR,R7          TEST FOR NULL ARGUMENT
         BEZ      ADDFILE2
         MTW,0    COPYSTDF,R7       IS THIS A STD FILE
         BLEZ     ADDFILEC          NO
         CI,R5    2                 IS ARG AN ACCOUNT
         BNE      ADDFILEC          NO
        LW,R1    CMBX,R7
        CI,R1    PRNTBUF+PRNTBUF+PRNTBUF+PRNTBUF
        BG       ADDFILEC          NOT ON COPYSTD CMD ITSELF
         LW,R1    LINENO,R7
         STW,R1   SFACCT,R7         SAVE CMBX VALUE FOR ACCT
ADDFILEC EQU      %
         LW,R1    FILE,R7
         CI,R1    6                 ACCOUNT ONLY
         BNE      ADDFILE3          NO
         LI,R5    6                 SET R5 TO INDICATE LAST ARG
         LI,R1    2                 SET R1 TO ACCT CODE FOR STORVLP
         B        ADDFILE4
ADDFILED EQU      %
         LI,R6    1
         STW,R6   FILE,R7
         LW,R1    FILE+1,R7         COPYING TO TEMP RAD FILE
         CI,R1    SFTEMP+SFTEMP+SFTEMP+SFTEMP
         BE       ADDFILEB          YES
         LW,R1    TOARG+4,R7        POINT TO FILE NAME OF INPUT
         B        ADDFILEB
ADDFILE3 LW,R1    R5
ADDFILE4 BAL,SR4  STORVLP           ADD FILE PARAMETER TO OPEN FPT
ADDFILE2 AI,R5    1
         CW,R5    FILE,R7
         BLE      ADDFILE1
         CI,SR2   1
         BANZ     ADDOPL            OUTPUT
         CI,R5    2                 WAS ACCT SPECIFIED
         BG       ADDOPL            YES
         LW,R1    SFACCT,R7         WAS ACCT PRESENT ON COPYSTD
         BEZ      ADDOPL            NO
         MTW,0    COPYSTDF,R7       ARE WE OPENING F:STD
         BLZ      ADDOPL            YES
         STW,R1   CMBX,R7           POINT TO ACCT FOR COPYSTD
         B        ADDFILE1
*
ADDOPL   EQU      %
         CI,SR2   1
         BAZ      ADDOPL3           INPUT
         LI,SR3   RDTBL+1           ADR OF RD ACCT TABLE
         LW,SR1   RDTBL             ARE RD ACCTS PRESENT
         BNEZ     ADDOPL4           YES
ADDOPL8  EQU      %
         LI,SR3   WRTBL+1      ADR OF WR ACCT TABLE
         LW,SR1   WRTBL        ARE WR ACCTS PRESENT
         BNEZ     ADDOPL4      YES
ADDOPLA  EQU      %
         LI,SR3   EXTBL+1      ADR OF EX ACCT TABLE.
         LW,SR1   EXTBL        ARE WR ACCTS PRESENT.
         BNEZ     ADDOPL4      YES
ADDOPLB  EQU      %
         LW,SR1   UNTBL        ARE UN ACCTS PRESENT
         BEZ      ADDOPL3      VEHICLE ACCT NOT PRESENT.
         LI,SR3   UNTBL+1
ADDOPL4  LW,R2    *SR3              GET CMBX VALUE OF 1ST ACCT
         STW,R2   CMBX,R7
         LI,R5    2                 SET TO INDICATE ACCT
         B        ADDFILE1
ADDOPL5  LW,R2    NCHAR,R7          NULL FIELD
         BEZ      ADDOPL7           YES
         LI,R1    6                 CODE FOR READ ACCT
         CI,SR3   RDTBL+1           ARE WE ADDING READ ACCTS
         BE       ST%VLP       YES.
         LI,R1    7            CODE FOR WR ACCT.
         CI,SR3   WRTBL+1      WRITE ACCTS
         BE       ST%VLP       YES
         LI,R1    8            CODE FOR EXECUTE ACCT.
         CI,SR3   EXTBL+1      ARE WE ADDING EXECUTE ACCOUNTS.
         BE       ST%VLP       YES
         LI,R1    9            CODE FOR VEHICLE ACCT.
ST%VLP   EQU      %
         BAL,SR4  STORVLP           ADD RD OR WR ACCT TO OPEN FPT
ADDOPL7  BDR,SR1  ADDFILE1          LOOP ON NUMBER OF ACCTS
         CI,SR3   RDTBL+1           READ ACCT
         BE       ADDOPL8           YES - GO TEST FOR WR
         CI,SR3   WRTBL+1      WRITE ACCOUNT?
         BE       ADDOPLA      YES--GO TEST FOR EX
         CI,SR3   EXTBL+1      EXECUTE ACCOUNT
         BE       ADDOPLB      YES--GO TEST FOR UNDER
ADDOPL3  EQU      %
         LI,R3    X'FFFF'
         STW,R0   #DELIM,R7         RESET DELIMITER FLAG
         LW,R6    DEV%SAV1,R7  RESTORE DEVICE CODE.
         LW,R2    IN%ARG,R7
         CI,SR2   1            CHECK FOR INPUT.
         BAZ      %+2          INPUT.
         LW,R2    OUT%ARG,R7   LOAD OUTPUT DEVICE.
         MTW,0    DEVICE,R7
         BEZ      ADDOPL1      SYSTEM DEVICE SPECIFIED.
         MTW,0    R2
         BNE      ADDOPL1      BRANCH IF BT SPECIFIED.
         LH,R2    DVOPL,R6          TEST FOR OP LABEL ASSIGNMENT
         BNEZ     ADDOPL1
         MTW,0    MODE+1,R7         7T OR 9T SPECIFIED
         BEZ      ADDOPL2           NO -IT IS DC SPECIFICATION
         LI,R1    3
         DO1      VERSION=2
         LI,R2    '7T'
         DO1      VERSION=1
         LI,R2    X'8900'           TYPE CODE FOR 7T
         CW,R1    MODE+1,R7         7T SPECIFIED
         BANZ     %+2               YES
         DO1      VERSION=2
         LI,R2    '9T'              NO-IT MUST BE 9T SPECIFICATION
         DO1      VERSION=1
         LI,R2    X'8800'           TYPE CODE FOR 9T
ADDOPL1  STS,R2   OPNFPT+12,R7   PUT OP LABEL ASN IN OPEN FPT.
         DO       VERSION=1
         AND,R2   R3
         CI,R2    X'8A00'           TEST IF TYPE CODE
         BG       ADDOPL2           NO
         LI,R1    X'10000'
         STS,R1   OPNFPT+12,R7   SET BIT 15 FOR TYPE CODE.
         FIN
*
ADDOPL2  EQU      %
         LW,R1    MODE,R7      CHECK MODE FOR ASCII OR EBCDIC.
         AND,R1   =X'F0000000'
         BEZ      NXT%PAR      NOT ASCII OR EBCDIC.
         LW,R1    =X'00000200'
         STS,R1   OPNFPT+1,R7  SET P22 PRESENCE BIT IN FPT.
         LW,R1    MODE,R7
         AND,R1   =X'10000000'   TEST FOR ASCII
         BEZ      NXT%PAR      NOT ASCII
         LI,R4    1
         STW,R4   OPNFPT+15,R7   SET CCF TO 1 FOR ASCII.
NXT%PAR  EQU      %
         LW,R1    DENSITY,R7        CHECK IF DENSITY WAS SPECIFIED.
         BEZ      NXT%PAR1     NO
         LW,R1    =X'00000400'
         STS,R1   OPNFPT+1,R7  SET P21 PRESENCE BIT IN FPT.
         LW,R1    DENSITY,R7
         CI,R1    1
         BNE      NXT%PAR1
         STS,R1   OPNFPT+14,R7   SET 800 BPI BIT IN FPT.END
NXT%PAR1 EQU      %
         LW,R1    DEVICE,R7    TEST DEVICE FOR LT OR DC.
         BNEZ     ADDOPL22
         LW,R1    DEV%IN,R7    CHECK FOR INPUT DEVICE.
         CI,SR2   1            TEST IF CREATING INPUT DCB.
         BAZ      %+2          YES.
         LW,R1    DEV%OUT,R7   CREATING OUTPUT DCB.
ADDOPL22 EQU      %
         AI,R1    -2
         BLEZ     INPUT
         CI,R1    5
         BE       ADDOPL9           ANS TAPE
         CI,R1    3
         BG       INPUT
         BNE      %+2
         LI,R1    1                 DP - SET FILE FLAG
ADDOPL9  EQU      %
         STS,R1   OPNFPT+1,R7       SET FILE OR LABEL EXISTANCE FLAG
*
INPUT    CI,SR2   1                 CREATING INPUT DCB
         BANZ     OUTPUT            NO
         LW,R1    =X'00400000'
         CS,R1    M:EI
         BAZ      NO%RESI          M:EI HAS NOT BEEN OPENED YET.
         LI,R1    M:EI
         CAL1,1   RESETFPT          RESET M:EI DCB
NO%RESI  EQU      %
*
         LI,R1    M:EI              ADD DCB ADDRESS TO FPT
         MTW,0    COPYSTDF,R7       IS THIS A STD FILE
         BGEZ     %+2               NO
         LI,R1    F:STD             DCB ADDRESS FOR STD
         STW,R1   DCBADD,R7
         STS,R1   OPNFPT,R7
         CI,R6    7                 TEST IF ANS TAPE
         BNE      %+3               NO
         LW,R1    ANSBLK+3
         STW,R1   OPNFPT+13,R7   SET CONCAT
*
         STW,R0   TLABEL            SET NO FILE LABEL
         CI,R6    4            COMING FROM LABELED TAPE.
         BNE      INPUT1            NO
         LI,R1    TLBLSIZE          BYTE SIZE OF TLABEL
         SLS,R1   24                LABEL BUFFER
         STW,R1   TLABEL
         STW,R0   TLABEL+1          RESET RANDOM ID
INPUT1   EQU      %
*
         CI,SR2   2                 FPARAM OPTION INPUT DCB
         BAZ      INXTF             NO
         LI,R1    FPARAM            STORE FPARAM ADDRESS IN FPT
         AW,R1    R7
         STW,R1   OPNFPT+9,R7
*
INXTF    CI,SR2   4                 NEXT FILE OPTION INPUT DCB
         BAZ      OPEN5             NO
         MTW,0    COPYPHY
         BNEZ     %+3               LABELED TAPE IN PHYS ORDER
         CI,R6    4
         BE       INXTF2            LABELED TAPE IN SORT ORDER
         LB,R1    FROMFILE          RANGE START SPECIFIED
         BEZ      INXTF2            NO
         STW,R1   NCHAR,R7          SAVE NO OF CHARS
         LCI      4                 MOVE FROM FIELD TO ARG BUFFER
         LM,R1    FROMFILE
         STM,R1   ARGBUFF,R7
         LM,R1    FROMFILE+4
         STM,R1   ARGBUFF+4,R7
         LI,R1    1                 INDICATE FILE NAME
         BAL,SR4  STORVLP           PUT IN VLP
         B        OPEN5
INXTF2   EQU      %
         LW,R1    =X'01000108'
         STW,R1   VLPOPEN,R7        INITIALIZE FILE NAME ENTRY
         LW,R1    =X'01000000'
         STW,R1   VLPOPEN+1,R7
INXTF3   LI,R1    X'400'            SET NXTF FLAG IN FPT
         STS,R1   OPNFPT+1,R7
         LI,R1    IOERR2
         STW,R1   OPNFPT+3,R7
         STW,R1   OPNFPT+4,R7       IN CASE OF PASSWORD
*
OPEN5    CI,SR2   8                 INOUT MODE
         BAZ      OPEN1             NO
         B        OPENA
*
OUTPUT   EQU      %
         LW,R1    =X'00400000'
         CS,R1    M:EO
         BAZ      NO%RESO          OUTPUT HAS NOT BEEN OPENED YET.
         LI,R1    M:EO
         CAL1,1   RESETFPT          RESET M:EO DCB
NO%RESO  EQU      %
         LI,R1    M:EO
         STW,R1   DCBADD,R7
         STS,R1   OPNFPT,R7
         LW,R1    MODE+1,R7
         CW,R1    =X'00FF0000'      WAS EXP OPTION SPECIFIED
         BAZ      OUTPUTC           NO
         LCI      3
         LM,R1    EXPIRE,R7
         STM,R1   ARGBUFF,R7        PUT DATE IN ARGUMENT BUFFER
         LI,R1    5
         BAL,SR4  STORVLP           PUT ENTRY IN VLP
OUTPUTC  EQU      %
*
         LI,R2    0
         LI,R1    X'05'
         BAL,SR4  CALL1             GO-RESET VFC
*
         LB,R3    M:EI+12
         STW,R3   OPNFPT+11,R7      SET MAX KEY LENGTH
         LI,R3    X'F0'             SET OUTPUT ORGANIZATION TO THAT
         AND,R3   M:EI+5            OF INPUT ORGANIZATION
         SLS,R3   -4
         STW,R3   OPNFPT+6,R7
         CI,R6    7
         BE       OUTPUTK           ANS TAPE
*
         CI,R3    3                 TEST IF RANDOM
         BNE      OUTPUT1           NO
         LI,R1    1
         LH,R4    M:EI+20,R1        GET RLIM FROM DCB
         CI,R6    4                 GOING TO LABELED TAPE
         BNE      OUTPUT9           NO
         STW,R1   OPNFPT+6,R7       SET ORG TO CONSEC
         LCI      2
         LM,R2    RFILE
         STM,R2   TLABEL            PUT RANDOM ID IN TLABEL
         STW,R4   TLABEL+2          ENTER RLIM IN LABEL BUFFER
         B        OUTPUT1
OUTPUT9  EQU      %
         STW,R4   OPNFPT+14,R7      SET RSTORE
         CI,R6    5                 IS DEVICE DP
         BNE      OUTPUT1           NO
         LI,R1    X'B00'            SET CODE FOR DP IN FPT
         STW,R1   OPNFPT+12,R7
OUTPUT1  EQU      %
         CI,R6    5                 IS OUTPUT TO A DEVICE
         BG       OUTPUT8           YES
         LI,R1    3
         CW,R1    TOARG+5,R7        IS INPUT COMPRESSED
         BE       OUTPUT8           YES
         CW,R1    CODE,R7           IS OUTPUT COMPRESSED
         BNE      OUTPUTB           NO-DON'T CHANGE ORG
OUTPUT8  EQU      %
         LI,R1    1                 YES - SET ORG TO CONSEC
         STW,R1   OPNFPT+6,R7
         B        OUTPUTB
OUTPUTK  EQU      %
         LI,R4    0
         LI,D4    4                 SET 'U' FORMAT
         LW,R2    ANSBLK+1
         LW,R5    ANSBLK
         BEZ      OUTPUTJ           NO BLK OPTION GIVEN
         CW,R6    TOARG,R7          IS COPY ANS TO ANS
         BE       BLKERR2           YES-OPTION IS INVALID
         CW,R6    DEV%IN,R7    CHECK SYSTEM DEVICE.
         BE       BLKERR2
         STW,R5   OPNFPT+5,R7       PUT BLK IN OPEN FPT
         LI,D4    1                 CHANGE FORMAT TO 'F'
         AI,R2    0
         BEZ      OUTPUTJ           NO REC OPTION GIVEN
         STW,R2   OPNFPT+14,R7      PUT REC IN OPEN FPT
OUTPUTG  DW,R4    R2
         AI,R4    0                 TEST IF REC X N =BLK
         BNE      BLKERR            NO
OUTPUTJ  CW,R6    TOARG,R7
         BE       OUTPUTD           ANS TO ANS COPY
         CW,R6    DEV%IN,R7    CHECK SYSTEM DEVICE.
         BE       OUTPUTD
         MTW,0    ANSBLK+2          NON-ANS TO ANS - TEST FOR FMT OPT
         BEZ      OUTPUTE
FMTERR   LI,R1    55                INVALID FORMAT CODE FOR ANS
         B        ERRTN
BLKERR   CW,R6    TOARG,R7
         BE       %+3
         CW,R6    DEV%IN,R7
         BNE      BLKERR1            NOT ANS INPUT
         CI,R3    2
         BE       OUTPUTD           OK IF D
         CI,R3    3
         BE       OUTPUTD           OR V FORMAT
BLKERR1  EQU      %
         LI,R1    54                BAD VALUE FOR ANS OPTION
         B        ERRTN
BLKERR2  LI,R1    56                BLK OR REC INVALID ON ANS TO ANS
         B        ERRTN
OUTPUTE  AI,R5    0
         BNEZ     OUTPUTF           BLK OPTION USED
         AI,R2    0
         BEZ      OUTPUTF           REC OPT WAS NOT GIVEN
         STW,R2   OPNFPT+14,R7      PUT REC IN OPEN FPT
         STW,R2   OPNFPT+5,R7       PUT REC IN BLK
OUTPUTF  LI,R2    1
         CW,R2    TOARG,R7          IS INPUT FROM CARD READER
         BE       OUTPUTB           DEFAULT FMT IS F
         STW,D4   OPNFPT+6,R7       SET FMT TO U OR F
         B        OUTPUTB
OUTPUTD  EQU      %
         STW,R3   OPNFPT+6,R7
         MTW,0    TOARG+15,R7
         BNEZ     SELERR            RECORD SELECTION IS INVALID
         LW,R1    ANSBLK+2
         BEZ      OUTPUTH           FMT OPTION NOT USED
         CI,R3    1
         BLE      FMTERR            F FMT NOT VALID
         CI,R3    4
         BE       FMTERR            U FMT NOT VALID
         CW,R3    R1
         BNE      OUTPUTH
         STW,R0   ANSBLK+2          FMT CODES SAME - NO CONV NEEDED
OUTPUTH  EQU      %
         LH,R5    M:EI+3            GET BLKSZ FROM INPUT
         SLS,R5   -1
         STW,R5   ANSBLK
         STW,R5   OPNFPT+5,R7
         LH,R2    M:EI+18           GET REC SIZE FROM INPUT
         SLS,R2   -1
         STW,R2   ANSBLK+1
         STW,R2   OPNFPT+14,R7
OUTPUTB  EQU      %
         LW,R1    SEQUENCE,R7       TEST IF LN OR NLN SPECIFIED
         CI,R1    1
         BLE      OUTPUT2           NO
         BANZ     OUTPUT2           NO
         SLS,R1   -1
         STW,R1   OPNFPT+6,R7       RESET ORGANIZATION
         CI,R1    2                 TEST IF LN
         BNE      OUTPUT2           NO
         LI,R1    3
         STW,R1   OPNFPT+11,R7      RESET MAX KEY LENGTH
OUTPUT2  EQU      %
         LI,R1    2                 SET ACCESS DIRECT ON OUTPUT
         STW,R1   OPNFPT+7,R7       TO AVOID ABN 18
*
         LI,R1    4
         CW,R1    TOARG,R7          IS INPUT FROM LABEL TAPE
         BE       %+3          YES
         CW,R1    DEV%IN,R7    CHECK SYSTEM DEVICE.
         BNE      OUTPUTA           NO
         LI,R3    7
         LI,R2    1
         CS,R2    OPNFPT+1,R7       IS OUTPUT TO A FILE
         BNE      OUTPUTA           NO
         LW,R1    TLABEL+1
         CW,R1    RFILE+1           IS FILE RANDOM
         BNE      OUTPUTA           NO
         LI,R1    3
         STW,R1   OPNFPT+6,R7       SET ORG FOR RANDOM
         LW,R1    TLABEL+2
         STW,R1   OPNFPT+14,R7      GET RSTORE FROM LABEL BUFFER
OUTPUTA  EQU      %
         CI,SR2   4
         BANZ     OUTPUT6           NXTF BIT SET
         MTW,0    FILE,R7           IS OUTPUT TO A FILE
         BEZ      OPEN4             NO
         MTW,0    TOARG+3,R7        IS INPUT FROM A FILE
         BEZ      OPEN2             NO - DONT WANT FPARAM
         LI,R1    7
         CW,R1    DEVICE,R7         IS OUTPUT TO ANS TAPE
         BE       OPEN2             YES
         CW,R1    TOARG,R7          IS INPUT FROM ANS TAPE
         BE       OPEN2             YES
         CW,R1    DEV%IN,R7    INPUT SYSTEM ANS?
         BE       OPEN2        YES.
         CW,R1    DEV%OUT,R7   OUTPUT SYSTEM ANS?
         BE       OPEN2        YES.
         LW,R1    MODE+3,R7         TEST IF FA OR NFA SPECIFIED
         CI,R1    X'FF00'
         BAZ      OUTPUT4           NEITHER
         CI,R1    X'0300'
         BANZ     OUTPUT3           FA
         BAL,SR4  CLOSEI           CLOSE INPUT IN CASE NAMES ARE =
         B        OPEN2             NFA
OUTPUT4  LI,R2    VLPOPEN+1
         AW,R2    R7                ADR OF FILE NAME IN VLP
         LB,R3    M:EI+23
         CB,R3    *R2               COMPARE M:EI AND M:EO FILE NAMES
         BNE      OPEN2
         LB,R1    M:EI+23,R3
         CB,R1    *R2,R3
         BNE      OPEN2
         BDR,R3   %-3
OUTPUT3  AI,SR2   2                 SAME - SET FPARAM BIT
OUTPUT6  EQU      %
         LI,R1    4
         CW,R1    TOARG,R7          IS INPUT FROM TAPE
         BE       OUTPUT5           YES
         CW,R1    DEVICE,R7         IS OUTPUT TO TAPE
         BE       OUTPUT5           YES
         CW,R1    DEV%IN,R7    SYSTEM TAPE SPECIFIED?
         BE       OUTPUT5      SYSTEM INPUT TAPE.
         CW,R1    DEV%OUT,R7   SYSTEM TAPE SPECIFIED?
         BE       OUTPUT5
         BAL,SR4  CLOSEI            ALLOW COPY OVER SAME FILE
OUTPUT5  EQU      %
         CI,SR2   2                 TRANSFER VLP TO OUTPUT DCB
         BAZ      OPEN2             NO
         CI,D2    1                 WAS INPUT FILE OPENED
         BG       OPEN2             NO
         PAGE
         LI,R1    1                 SET BYTE DISP. REG'S FOR VLP TRANS.
         LI,R2    2
         LI,R3    3
         LI,SR3   FPARAM            GET FPARAM ADDRESS
         AW,SR3   R7
*
TRANFP1  LI,SR4   VLPOPEN           VARIBLE LIST PARAMETER ADDRESS
         AW,SR4   R7
         LB,R4    *SR3              GET NEXT FPARAM CODE
         CI,R4    7
         BE       TRANFP5           DONT TRANSFER SN
         CI,R4    4                 NAME-ACCT-PASS-EXPIRE
         BE       TRANFP5           DON'T MOVE EXPIRE
         BG       TRANFP2           NO
         CI,SR2   4                 NXTF OPTION GIVEN
         BAZ      TRANFP5           NO-DONT CHANGE N.A.P FROM COMMAND
*
TRANFP2  CB,R4    *SR4              FPARAM CODE = FPT CODE
         BE       TRANFP3           YES
         LB,R6    *SR4,R1           GET LEI OF FPT CODE
         STB,R0   *SR4,R1
         LB,R5    *SR4,R3           INCREMENT TO NEXT FPT ENTRY
         AW,SR4   R5
         AI,SR4   1
         CI,R6    0                 TEST FOR LAST ENTRY
         BE       TRANFP2           NOT LAST ENTRY
*
         LW,R4    *SR3              TRANSFER NEW CODE WORD TO END OF FPT
         STW,R4   *SR4
         STB,R1   *SR4,R1           SET LEI
         LB,R4    *SR3,R3
         B        TRANFP4           GO TRANSFER PARAMETER
*
TRANFP3  LB,R4    *SR4,R2           IS FPT ENTRY EMPTY
         BNEZ     TRANFP5           NO-DONT TRANSFER PARAMETER
         LB,R4    *SR3,R2           TRANSFER NO. OF SIGNIFICANT WORDS
         CB,R4    *SR4,R3           ROOM FOR THIS ENTRY
         BLE      %+2               YES
         LB,R4    *SR4,R3           NO-TRUNCATE DOWN TO WHATS AVIALIBLE
         STB,R4   *SR4,R2
TRANFP4  LW,R5    *SR3,R4           TRANSFER PARAMETER
         STW,R5   *SR4,R4
         BDR,R4   %-2
*
TRANFP5  LB,R4    *SR3,R1
         BNEZ     OPEN2             END OF FPARM LIST
         LB,R4    *SR3,R3           INCREMENT TO NEXT FPARAM ENTRY
         AW,SR3   R4
         AI,SR3   1
         B        TRANFP1
         PAGE
OPEN2    EQU      %
         DO       VERSION=2
         MTW,0    J:JIT             BATCH MODE
         BGEZ     OPEN4             YES-NO ON-OVER TESTING
         LI,R3    7
         LI,R2    1
         CS,R2    OPNFPT+1,R7       IS OUTPUT TO A FILE
         BNE      OPEN4             NO-SKIP TO-OVER TESTING
         CI,SR2   4                 COPYALL
         BANZ     OPEN4             YES-SKIP TO-OVER TESTING
         MTW,0    COPYSTDF,R7       COPYSTD
         BNEZ     OPEN4             YES - OK
         LI,R1    12
         CW,R1    TOVER,R7          OVER SPECIFIED
         BE       OPEN4             YES-OK
         LI,R1    TOVERABN
         STW,R1   OPNFPT+4,R7       SET ABNORMAL FOR -TO-
         CAL1,1   OPNFPT,R7         OPEN IN
         BAL,SR4  CLOSEO            FOUND IT IS THERE-CLOSE IT
         CAL1,1   FPTON
         USECT    PLSECT
FPTON    GEN,8,7,17      X'11',0,M:UC
         DATA     X'34000010'
         DATA     %+3
         DATA     9
         DATA     0                 BTD
         TEXT     'ON FILE '''
         USECT    BLDCB
         LI,R1    VLPOPEN+1
         AW,R1    R7                ADDRESS OF FILE NAME
         LI,D3    PRTBUF
         AW,D3    R7                BUFFER ADDRESS
         BAL,SR4  UNPRINT           PUT NAME IN BUFFER
         CAL1,1   FPTON1            PRINT 'FILE NAME'
         USECT    PLSECT
FPTON1   GEN,8,7,17      X'11',0,M:UC
         DATA     X'34000010'
         PZE      *D3               BUFFER
         PZE      *R2               SIZE
         DATA     1                 BYTE OFF SET
         USECT    BLDCB
         CAL1,1   FPTON2            PRINT 'ILLEGAL'
         USECT    PLSECT
FPTON2   GEN,8,7,17      X'11',0,M:UC
         DATA     X'34000010'
         DATA     %+3               BUFFER
         DATA     10                SIZE
         DATA     0                 NO BYTE OFF SET
         TEXT     ''' ILLEGAL
'
         USECT    BLDCB
         LI,D2    3                 SET SEVERITY AT MAX
         B        RETURN            AND GO TO NEXT COMMAND
TOVERABN EQU      %
         LB,R1    SR3
         CI,R1    3                 FILE NOT PRESENT
         BNE      IOERR1            NO-SOME OTHER PROBLEM
         LI,R1    IOERR1
         STW,R1   OPNFPT+4,R7       RESTORE ABNORMAL ADDRESS
         FIN
OPEN4    LI,R3    2                 INTIALIZE OUTPUT MODE
         LW,R1    DEVICE,R7
         BNEZ     %+2          PCL OUTPUT DEVICE.
         LW,R1    DEV%OUT,R7   SYSTEM OUTPUT DEVICE.
         CI,R1    3                 OUTPUT TO RAD
         BE       %+3               YES
         CI,R1    5                 OUTPUT TO DP
         BNE      OPEN6             NO- SET OUTPUT MODE
         CI,SR2   4                 COPYALL TO RAD
         BAZ      OPEN6             NO-OPEN-OUT-MODE
         LI,R1    X'FF00'
         AND,R1   SYN,R7            ADDING A SYNONYM
         BEZ      OPEN6             NO-SET OUTPUT MODE
OPENA    EQU      %
         LI,R3    4                 INOUT MODE
         STW,R3   OPNFPT+8,R7
         B        OPEN1             OPEN DCB FOR SYNONYM
OPEN6    EQU      %
         STW,R3   OPNFPT+8,R7
         CI,D2    2                 DOES INPUT EXIST
         BL       OPEN1             YES - GO OPEN OUTPUT
         DO1      VERSION=1
         B        RETURN
         DO       VERSION=2
         LI,R3    X'F000'
         STS,R3   OPNFPT+1,R7       FLAGS FOR OPEN PRIME AND VLP LIST.
         FIN
         PAGE
OPEN1    CAL1,1   OPNFPT,R7         OPEN CURRENT DCB
*
OPEN3    EQU      %
         CI,SR2   1
         BAZ      OPEN9             INPUT
         LW,R1    DEVICE,R7
         BNEZ     %+2          PCL OUTPUT DEVICE.
         LW,R1    DEV%OUT,R7   SYSTEM OUTPUT DEVICE.
         CI,R1    4                 IS DEVICE LT
         BE       OPENB
         CI,R1    7                 OR ANS
         BE       OPENB
         CI,R1    6                 OR FT
         BNE      OPEN9             NO
OPENB    EQU      %
         MTW,0    DEVICE+1,R7       WAS SN SPECIFIED
         BNEZ     OPEN9             YES
         MTW,0    SCRATCH,R7        IS THIS 1ST OPEN FOR SCRATCH
         BNEZ     OPEN9             NO
         LW,R2    DEVICE,R7
         BNEZ     %+2          PCL OUTPUT DEVICE.
         LW,R1    DEV%OUT,R7   SYSTEM OUTPUT DEVICE.
         CI,R2    7                 TEST IF ANS TAPE
         BE       OPEN9             YES
         LI,R1    M:EO+22
         LI,R3    3
OPEN7    LB,R2    *R1               SEARCH FOR SN IN VLP
         CI,R2    7
         BE       OPEN8             FOUND
         LB,R2    *R1,R3
         AW,R1    R2
         AI,R1    1                 STEP TO NEXT VLP ENTRY
         B        OPEN7
OPEN8    LW,R1    1,R1
         STW,R1   SCRATCH,R7        SAVE SCRATCH SER NO
         DO       VERSION=2
         MTW,0    J:JIT
         BGEZ     OPEN9             BATCH MODE - SKIP MESSAGE
         STW,R1   PRTBUF+6,R7       OUTSN TO PRINT BUFFER
         LW,R1    =X'15000000'
         STW,R1   PRTBUF+7,R7       ADD CR
         LCI      6
         LM,R1    SERNO
         STM,R1   PRTBUF,R7         MOVE MESSAGE TO PRINT BUFFER
         LI,R1    PRTBUF
         AW,R1    R7                ADDRESS OF PRINT BUFFER
         CAL1,1   SNFPT             PRINT MESSAGE WITH SER NO
         USECT    PLSECT
SNFPT    GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         PZE      *R1
         DATA     28                LENGTH
         DATA     1                 BTD
         USECT    BLDCB
         FIN
OPEN9    EQU      %
         LI,R2    0                 FLAG BCD/BIN IN DEVICE FPT
         LW,R1    MODE,R7
         CW,R1    =X'02000000'
         BAZ      %+2
         AI,R2    X'10'
*
         LW,R1    MODE+2,R7         FLAG PK/UPK IN DEVICE FPT
         CI,R1    1                 PK OPTION SET
         BANZ     %+2               YES
         AI,R2    X'40'
*
         LW,R1    CODE,R7
         CI,R1    4                 H CONVERSION
         BNE      %+2               NO
         AI,R2    X'20'             YES-SET FLAG FOR CAL
*
         LI,R1    X'22'             SET BCD/BIN AND PK/UPK IN DCB
         BAL,SR4  CALL1
*
         LW,R2    MODE+3,R7
         LB,R3    R2
         BEZ      RETURN
         AI,R3    -6
         CI,R3    3                 TEST FOR VFC
         BE       ADDSP2
         LW,R2    =X'80000000'      SET SSP/DSP IN DCB
         LI,R1    X'25'
         BAL,SR4  CALL1
         B        RETURN
*
ADDSP2   LI,R2    X'10'             SET VFC IN DCB
         LI,R1    X'05'
         BAL,SR4  CALL1
*
RETURN   LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *SR4
*
IOERR2   LW,R1    *R7
         STW,SR3  -1,R1             PUT ERROR ABNORMAL CODE IN
         B        RETURN            RETURNED SR3
*
IOERR1   LW,R1    *R7               PUT ERR OR ABN CODE IN
         CI,SR2   4                 WAS RANGE SPEC PRESENT
         BAZ      IOERR3            NO - ERROR
         CI,SR2   1                 COPYING A SYNONYM
         BANZ     IOERR2            YES - ERROR
         MTW,0    COPYPHY           WAS PHY OPTION USED
         BEZ      INXTF3            NO - GO DO OPEN NEXT
         LW,R2    FROMCMBX
         STW,R2   CMBX,R7           SET TO END OF FROM FIELD
IOERR3   EQU      %
         STW,SR3  -1,R1             RETURNED SR3
         LI,R1    0                 FLAG I/O ERROR
ERRTN    EQU      %
         BAL,SR4  ERROR
         B        RETURN
SELERR   LI,R1    27                REC SEL INVALID FOR DEVICE
         B        ERRTN
*
RFILE    DATA     X'0C000000'       TAPE HEADER FOR RANDOM FILE
         TEXT     'RFIL'
*                      E           A          BCD          BIN
DEFAULT  DATA     X'BFFF0217',X'40008517',X'80010118',X'16580218'
*                      9T         SSP
         DATA     X'1658041F',X'00060724'
MAXSN    EQU      50                MAX NUMBER OF SERIAL NUMBERS
*
         DO       VERSION=2
SERNO    TEXT     ' OUTPUT SERIAL NUMBER = '
*                    CR   PR  DC LT DP FT AT  ME   LP   CP   PP
DVOPL    DATA,2   0,'CR','PR',00,00,00,00,00,'ME','LP','CP','PP'
*                 REW
         DATA,2   'MT',0
         ELSE
*                    CR   PR  DC LT DP FT AT ME  LP   CP   PP
DVOPL    DATA,2   0,'C ','EI',00,00,00,00,00,00,'LO','PO','EO'
*                   MT
         DATA,2   X'8A00',0
         FIN
*
         BOUND    4
IOPNFPT  DATA     X'14020000'
         DATA     X'00005000'
         DATA     X'D73C5C00'
         DATA     IOERR1            ERROR ADDRESS
         DATA     IOERR1            ABNORMAL ADDRESS
         DATA     120               RECL OR BLKSZ
         DATA     1                 ORGANIZATION OR FMT
         DATA     1                 ACCESS:INPUT-SEQ, OUTPUT-DIRECT
         DATA     1                 MODE 1-IN,2-OUT,4-INOUT
         DATA     0                 FPARAM
         DATA     0                 TAPE FILE LABEL BUFFER ADDRESS
         DATA     31                MAX KEY LENGTH
         DATA     0                 OP LABEL
         DATA     0                 SPARE OR CONCAT
         DATA     0                 RSTORE OR LRCSZ
         DATA     0                 DSF
         DATA     0                 CCF
*
VLPOPEN  EQU      %-IOPNFPT+OPNFPT  OPEN VLP POINTER
         DATA     X'01000008'       FILE NAME
         DO1      8
         TEXT     '    '
         DO1      VERSION=2
         DATA     X'02000005'       ACCOUNT NO. (DEAD PASS WORD)
         DO1      VERSION=1
         DATA     X'02000002'       ACCOUNT NO.
         DATA     0,0
         DATA     X'03000002'       PASSWORD
         DATA     0,0
         DATA     X'05000010'       READ ACCT. NUMBERS
         DO1      16
         DATA     0
         DATA     X'06000010'       WRITE ACCT. NUMBERS
         DO1      16
         DATA     0
         DATA     X'04000002'       EXPIRATION DATE
         DATA     0,0
         DATA     X'14000010'  EXECUTE ACCT NUMBERS.
         DO1      16
         DATA     0
         DATA     X'15000003'       VEHICLE ACCT NUMBER.
         DATA     0,0,0
         DATA     X'0B000008'       SYNONYM FILE NAME
SYN      EQU      %-IOPNFPT+OPNFPT
         DO1      8
         DATA     0
         GEN,8,8,16 7,1,MAXSN       SN
         DO1      MAXSN
         DATA     0
OPENSIZE EQU      %-IOPNFPT
M:EI     DSECT    1
         GEN,8,16,8      96,0,3     SIZE,0,ASSIGNMENT
         GEN,15,17       1,X'10'    FUN=IN,OP LABEL=EI
         DATA     X'0A000000'       10 RETRIES
         GEN,15,17       120,0      MAX RECORD SIZE
         DATA     0
         DATA     X'80000011'       SAVE,CONSECUTIVE,SEQUENTAIL
         DATA     M:EI+22           VFP LIST PRINTER
         DO1      3
         DATA     0
         DATA     KB                KEY BUFFER
         DO1      11
         DATA     0
         DATA     X'01000008'       FILE NAME
         DO1      8
         TEXT     '    '
         DATA     X'02000002'       ACCT. NUMBER
         DO1      2
         TEXT     '    '
         DATA     X'03000002'       PASS WORD
         DO1      2
         TEXT     '    '
         DATA     X'05000010'       READ
         DO1      16
         TEXT     '    '
         DATA     X'06000010'       WRITE
         DO1      16
         TEXT     '    '
         DATA     X'04000002'       EXPIRATION DATE
         DO1      2
         TEXT     '    '
* FOLLOWING ENTRY IS USED BY TESTFILE TO RETURN PERTINENT INFORMATION
* FOR FILES ON A REVIEW COMMAND.
         DATA     X'11000101'
         DATA     0
         DATA     X'0B000008'       SYNON
         DO1      8
         TEXT     '    '
         DATA     X'14000010'   EXECUTE ACCT NUMBERS
         DO1      16
         DATA     0
         DATA     X'15000003'    VEHICLE ACCT NUMBER
         DATA     0,0,0
         GEN,8,8,16 7,1,MAXSN       SN
         DO1      MAXSN
         TEXT     '    '
KB       EQU      %
         DO1      8                 KEY BUFFER
         TEXT     '    '
M:EO     DSECT    1
         GEN,8,16,8      96,0,3     SIZE,0,ASSIGNMENT
         GEN,15,17       2,X'11'    FUN=OUT,OP LABEL=EO
         DATA     X'0A000000'       10 RETRIES
         GEN,15,17       120,0      MAX RECORD SIZE
         DATA     0
         DATA     X'80000011'       SAVE,CONSECUTIVE,SEQUENTAIL
         DATA     M:EO+22           VFP LIST POINTER
         DO1      3
         DATA     0
         DATA     KBO               KEY BUFFER
         DO1      11
         DATA     0
         DATA     X'01000008'       FILE NAME
         DO1      8
         TEXT     '    '
         DATA     X'02000002'       ACCT. NUMBER
         DO1      2
         TEXT     '    '
         DATA     X'03000002'       PASS WORD
         DO1      2
         TEXT     '    '
         DATA     X'05000010'       READ
         DO1      16
         TEXT     '    '
         DATA     X'06000010'       WRITE
         DO1      16
         TEXT     '    '
         DATA     X'04000002'       EXPIRATION DATE
         DO1      2
         TEXT     '    '
         DATA     X'0B000008'       SYNON
         DO1      8
         TEXT     '    '
         DATA     X'14000010'   EXECUTE ACCT NUMBERS
         DO1      16
         DATA     0
         DATA     X'15000003'   VEHICLE ACCT NUMBER
         DATA     0,0,0
         GEN,8,8,16 7,1,MAXSN       SN
         DO1      MAXSN
         TEXT     '    '
KBO      EQU      %
         DO1      8                 KEY BUFFER
         TEXT     '    '
F:STD    DSECT    1
         GEN,8,16,8     96,0,3      SIZE,0,ASSIGNMENT
         GEN,15,17      1,X'10'     FUN=IN,LABEL=EI
         DATA     X'0A000000'       10 RETRIES
         GEN,15,17      120,0       MAX RECORD SIZE
         DATA     0
         DATA     X'80000011'       SAVE,CONSECUTIVE,SEQUENTIAL
         DATA     F:STD+22          VFP LIST POINTER
         DO1      3
         DATA     0
         DATA     KBS               KEY BUFFER
         DO1      11
         DATA     0
         DATA     X'01000008'       FILE NAME
         DO1      8
         TEXT     '    '
         DATA     X'02000002'       ACCT NUMBER
         DO1      2
         TEXT     '    '
         DATA     X'03000002'       PASSWORD
         DO1      2
         TEXT     '    '
         DATA     X'05000010'       READ
         DO1      16
         TEXT     '    '
         DATA     X'06000010'       WRITE
         DO1      16
         TEXT     '    '
         DATA     X'04000002'       EXPIRATION DATE
         DO1      2
         TEXT     '    '
         DATA     X'0B000008'       SYNON
         DO1      8
         TEXT     '    '
         DATA     X'14000010'   EXECUTE ACCT NUMBERS
         DO1      16
         DATA     0
         DATA     X'15000003'   VEHICLE ACCT NUMBER
         DATA     0,0,0
         GEN,8,8,16 7,1,MAXSN       SN
         DO1      MAXSN
         TEXT     '    '
KBS      EQU      %
         DO1      8                 KEY BUFFER
         TEXT     '    '
RESETFPT DSECT    1
         GEN,8,24   X'94',R1
         GEN,16,1,1,1,1,12     0,1,0,1,1,0
         DATA     0
         GEN,1,1,1,1,1,1,1,1,24    1,0,1,1,1,1,1,1,0
         DO1      9
         DATA     0
         GEN,9,1,1,1,1,1,1,1,16    0,1,1,1,1,1,1,1,0
         USECT    BLDCB
         END
