         SYSTEM   SIG7
         SYSTEM   BPM
*M*      DELUTL IS USED TO CREATE AND MAINTAIN THE TP DELIVERIES FILE
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
R16      EQU      16
CONSNZ   EQU      8                 KEY AND DEL NAME SIZE
CRITER   EQU      31                MAX  SIZE OF A CRITERIA
ID       EQU      400               MAX SIZE OF A RECORD X 4
MAXCHAR  EQU      81                SIZE OF A LINE
******************************************************
*        F:DELX FILE FORMAT
*        COL 1-8  LOCATION STATION NAME LEFT JUSTIFIED
*                 AND BLANK FILLED
*        COL 9    BLANK UNUSED
*        COL 10-N DELIVERY CRITERIA SEPARATED BY BLANKS
*
*        FILE IS ORDERED ON COL 1-8
*
******************************************************
F:DELX   DSECT    1
F:DELX   M:DCB    (DEVICE,'DC'),(INOUT),(SAVE),(ABN,CE3),;
                  (ERR,CE3),(RECL,ID),(KEYED),(DIRECT),;
                  (FILE,'DUMMYFILE')
         REF      M:LO              PRINT ALL DATA AND INFORMATION HERE
         REF      M:SI              READ THE DATA AND DIRECTIVES FROM THIS
         DEF      DELUTL            ONE AND ONLY ONE ENTRY POINT
         CSECT    0
WORKBF   RES,1    ID                WORK BUFFER
*P*      NAME: DELUTL
*P*      PURPOSE: THE DELIVERIES UTILITY IS USED TO CREATE AND
*P*               MAINTAIN THE TRANSACTION PROCESSING DELIVERIES
*P*               FILE.  THIS FILE IS USED BY THE TP TIC TO ROUTE
*P*               REPORTS NOT SENT TO THEIR ORIG STATION.
*P*
*P*               THE DELUTL ACCEPTS DIRECTIVES AND DATA FROM M:SI
*P*               MAKING SURE THAT ALL ENTERED DATA IS CORRECT IN
*P*               FORMAT AND CONTENT.  ERRORS ARE WRITTEN UPON M:LL.
*P*      REFERENCE: TRANSACTION PROCESSING REFERENCE MANUAL
*P*               90-31-12
*D*      NAME: DELUTL
*D*      ENTRY: DELUTL
*D*      CALL: THE DELUTL IS A FREE STANDING SLAVE PROGRAM USABLE
*D*               EITHER ON-LINE OR IN THE BATCH MODE.
*D*      INTERFACE: NO SPECIAL INTERFACES ARE REQUIRED STD I-O IS USED
*D*      ENVIRONMENT: UNMAPPED,SLAVE,PRIVILEGE 40.
*D*      DATA : FORMAT FOR THE DELIVERIES FILE IS AS FOLLOWS
*DO*
*D*
*        F:DELX FILE FORMAT
*        COL 1-8  LOCATION STATION NAME LEFT JUSTIFIED
*                 AND BLANK FILLED
*        COL 9    BLANK UNUSED
*        COL 10-N DELIVERY CRITERIA SEPARATED BY BLANKS
*
*        FILE IS ORDERED ON COL 1-8
*
*FIN*
*D*               THE DCB NAME IS F:DELX AND IS OPENED IN-OUT.
*D*      INPUT:  FILE M:SI IS USED TO READ ALL INPUT DIRECTIVES
*D*               AND DATA
*D*      OUTPUT: FILES M:LO AND M:LL ARE USES FOR OUTPUT INFORMATION,
*D*               DATA AND ERROR MESSAGES.
DELUTL   EQU      %                 START HERE FOR UTILITY
         M:OPEN   F:DELX,(KEYM,CONSNZ),(INOUT),(KEYED)
         M:PC     '<'               PRINT A PROMPT
DRIVER   EQU      %                 WORKING DRIVER FOR UTILITY
         M:SETDCB F:DELX,(ABN,CE3),(ERR,CE3)
         BAL,R1   CARD              GO PRIME THE INPUT BUFFER
         LW,R1    CATYPE            TYPE OF DIRECTIVE
         CI,R1    TYPVN-TYPVEC-1    MAKE SURE ITS WITHING LIMITS
         BG       CE1               ERROR INVALID DIRECTIVE
         B        TYPVEC,R1
TYPVEC   B        DRIVER            RE-DO ANOTHER CARD
         B        LS                LIST SOMETHING
         B        MA                MATCH A CRITERIA
         B        IN                INSERT A STATION
         B        DE                DELETE ONE
         B        ADIT              ADD A CRITERIA
         B        SU                SUBTRACT ONE
         B        PAU               ALL DONE WITH END COMMANDD
TYPVN    EQU      %
MA       EQU      %                 MATCH A CRITERIA
         M:PRINT  (MESS,MAMS)
         M:WRITE  M:LO,(BUF,WORKBF),(SIZE,*CAINCNT),(WAIT)
         LW,R6    CAINCNT           INSERT A BLANK AFTER
         LI,R15   C' '              THE GIVEN STRING
         STB,R15  WORKBF,R6
         LI,R1    0                 BA OF EACH CRITERIA
         LI,R2    0                 CURRENT POSITION IN GIVEN DIR
MABLD    EQU      %                 GOT A BLANK
         LB,R15   WORKBF,R2         GET FIRST CHARACTER OF REPORT
         AI,R2    1                 POINT TO NEXT
         CW,R2    R6                SEE IF WE ARE DONE
         BG       MVDN              AL DONE
         CI,R15   C'#'              SEE IF IT START WITH A #
         BE       MABLD1            YES SO OK
         AI,R2    -1                BACKUP ONE
         M:PRINT  (MESS,RPTWRN)     WARN HIM ABOUT REPORT PREFIX
MABLD1   STW,R2   MVLST             BEGINNNG OF STRING
MA2      EQU      %                 SCAN ROUTINE
         CW,R2    R6                SEE IF WE ARE DONE
         BG       MVDN
         LB,R15   WORKBF,R2         SCAN FOR BLANK OR .
         AI,R2    1
         CI,R15   C' '
         BE       MA3               GOT AN END OF REPORT
         CI,R15   C'.'              CRITERIA    END
         BE       MA3               END OF CRITERIA
         B        MA2
MA3      LW,R3    R2                BUILD CBS WORD
         AI,R3    -1                GET CHARACTER COUNT
         SW,R3    MVLST             SIZE OF THE STRING
         SLS,R3   24
         LI,R4    BA(WORKBF)        BYTE ADDRESS OF KEY
         AW,R4    MVLST             STARTING OF CURRENT STRING
         OR,R4    R3                SIZE
         STW,R4   CAWBF,R1          SAVE THE ADDRES
         AI,R1    1                 INCREMENT FOR NEXT TIME
         CI,R1    MAXCHAR           DONT FILL UP BUFFER
         BG       MAER1             DONT FILL UP BUFFER
MVMOR1   EQU      %                 INCRENT FOR NEXT CHAR
         CI,R15   C' '              SEE WHERE TO RETURN TO
         BNE      MA2               JUT CONTINUE
         AI,R2    -2                BACKUP TO CHECK VALIDITY
         LB,R15   WORKBF,R2         OF THE RwPORT NAME
         CI,R15   C'.'              IT MUST END WITH A .
         BNE      MAER2             IF NOT ERROR
MVMS     AI,R2    2                 RESTORE X R 2
         B        MABLD             MOVE THE BEGINNING OF STRING
MVDN     EQU      %                 ALL DONE
         CI,R1    0
         BLE      MAER3             NO REPORT NAME SPECIFIED
         STW,R1   MVCRCN            SAVE NUMBER OF ENTRIES
         M:PFIL   F:DELX,(BOF)      REWIND THE FILE
MVLP     M:READ   F:DELX,(BUF,WBF2),(WAIT),(SIZE,ID),;
                  (ABN,LAEND)
         LW,R6    F:DELX+4          GET THE SIZE OF THE RECORD
         SLS,R6   -17
         LI,R15   C' '              BLANK PAST LAST CHAR TO MAKE
         STB,R15  WBF2,R6           SURE WE COMPARE IT
         LI,R2    CONSNZ            START AFTER THE NAME
MVLP1    LB,R15   WBF2,R2           START SCANNING FOR CRITERIA
         AI,R2    1
         CI,R15   C' '              BLANK DENOTES A START OF ONE
         BE       MVBL
         CW,R2    R6                SEE IF WE ARE DONE WITH THIS
         BGE      MVLP              ALL DONE
         B        MVLP1             STILL IN THIS RECORD
MVBL     LI,R1    0                 GOT A BLANK
MVBL1    LI,R4    BA(WBF2)          SCAN THRU THE CRITERIA
         AW,R4    R2
         LW,R5    CAWBF,R1          GET PREBUILD CRITERIA POINTERS
         CBS,R4   0
         BE       MVPRNT            GOT A HIT SO PRINT IT
MVNXC    AI,R1    1                 DO NEXT PREBUILD CRITERIA
         CW,R1    MVCRCN            ARE WE DONE
         BL       MVBL1             NOPE
         B        MVLP1             READ ANOTHER STN RECORD
MVPRNT   EQU      %                 PRINT THE IMAGE IF CORRECT
         LW,R5    =X'1000000'       CHECK LAST CHARACTER FOR A
         OR,R4    R5                BLANK MAKE SURw ITS A CRITERIA
         LW,R5    R4
         LI,R4    BA(KEYINT)+1      CANNED BLANK
         CBS,R4   0
         BNE      MVNXC             JUST IGNOR IT
         M:WRITE  M:LO,(BUF,WBF2),(WAIT),(SIZE,*R6)
         B        MVLP              DO ANOTHER RECORD
MAMS     TEXTC    C'.....MATCH THE FOLLOWING REPORT NAME(S)'
MVCRCN   RES      1                 NUMBER OF CRITERIA
MVLST    RES      1                 BASE
MAER1    M:PRINT  (MESS,CE22)
         B        MVMOR1            DO WHAT WE HAVE
MAER2    M:PRINT  (MESS,MAER22)     BAD REPORT NAME SPECIFIED
         B        MVMS              DO WHAT WE HAVE
MAER22   TEXTC    C'*****WARNING  REPORT NAME SHOULD END WITH A PERIOD'
RPTWRN   TEXTC    C'*****WARNING RREPORT NAME SHOULD START WIH A #'
MAER3    M:PRINT  (MESS,MAER33)     INVALID REPORT NAME
         B        DRIVER
MAER33   TEXTC    C'*****INVALID REPORT NAME SPECIFIED'
SU       EQU      %                 SUBTRACT A CRITERIA
         LI,R1    SUALL             SUBTRACT ALL LOCATION
         STW,R1   ASALSW            COMMON SPLIT
         LI,R1    SUONE             DO A NAMED STATION
         STW,R1   ASONSW            COMMON SPLIT
         B        ADITC             COMMON ENTRY
SUSWP    RES      1                 PRINT OLD SWITCH
SUSV4    RES      1                 CURRENT CHARACTER POSITION
SUALON   RES      1                 SUB FROM ONE OR ALL SWITC
SUOLD    TEXTC    C'.....OLD STATION RECORD IMAGE'
SUNEW    TEXTC    C'.....NEW STATION RECORD IMAGE'
SUONE    EQU      %                 SUBTRACT FROM NAMED STNS
         LI,R5    SUTSER            RETURN TO GET ANOTHER STN
         STW,R5   SUALON            EXIT SUB VECTOR
SUALT    EQU      %                 SUB ALL ALSO COMES HERE
         LI,R5    0                 PRINT OR NO PRINT OLD IMAGE
         STW,R5   SUSWP             INITILIZE SWITCH
         LI,R4    CONSNZ            SIZE OF A KEY
SULP     LB,R15   WBF2,R4           SCAN FOR A SPACE
         AI,R4    1
         CI,R15   C' '              SINCE IT DENOTED A NEW CRITERIA
         BE       SUCMPR            GOT A SPACE
         CW,R4    R6                ARE WE ALL DONE
         BLE      SULP              NOPE NOT YET
         B        SUDONE            ALL DONE SO RETURN
SUCMPR   STW,R4   SUSV4             SAVE OUR CURRENT POSITION
         LI,R5    BA(WBF2)          LOCATION OF CURRENT STRING
         AW,R5    R4                (CRITERIA)
         OR,R5    ADCRSZ2           SIZE OF OUR BASE CRITERIA
         AW,R5    =X'01000000'      CHECK THE BLANK ALSO
         LI,R4    BA(WORKBF)        LOCATION OF BASE CRITERIA
         CBS,R4   0
         BE       SUHIT             GOT A HIT
         LW,R4    SUSV4             RESTORE X R 4 AND CONTINUE
         B        SULP
SUHIT    EQU      %                 NOW SQUEEZE IT OUT
         LW,R1    SUSWP             SHALL WE PRINT OLD IMAGE
         CI,R1    0                 CHECK SWITCH
         BNE      SUNOP             ALREADY PRINTED OLD IMAGE
         M:PRINT  (MESS,SUOLD)      PRINT OLD IMAGE
         M:WRITE  M:LO,(BUF,WBF2),(WAIT),(SIZE,*R6)
         LI,R1    1                 DON'T PRINT OLD AGAIN
         STW,R1   SUSWP
SUNOP    EQU      %                 NOW DO ACTUAL SQUEEZE
         LW,R4    R6                GET TOTAL SIZE
         SW,R6    ADCRSZ            DECREMENT  BY CRITERIA SIZE
         AI,R6    -1                DON'T WANT EXTRA BLANK
         SW,R4    ADCRSZ            SIZE OF REMAINING STRING
         SW,R4    SUSV4
         CI,R4    0
         BLE      SUDONE
         SLS,R4   24
         LI,R5    BA(WBF2)
         AW,R5    SUSV4             TO LOCATION
         OR,R5    R4                SIZE OF REMAINING CHARACTERS
         LI,R4    BA(WBF2)+1        CALCULATE FROM ADDRESS
         AW,R4    SUSV4
         AW,R4    ADCRSZ            SIZE OF CRITERIA
         MBS,R4   0
         LW,R4    SUSV4             NOW CONTINUE WITH SCANNING
         B        SUCMPR            THE NEXT ONE MAY MATCH
SUDONE   EQU      %                 ALL DONE
         LW,R1    SUSWP             SHALL WE DISPLAY A NEW
         CI,R1    0                 STATION  RECORD
         BE       *SUALON           NOTHING FOUND
         M:WRITE  F:DELX,(BUF,WBF2),(WAIT),(SIZE,*R6),;
                  (KEY,LSKEY)
         M:PRINT  (MESS,SUNEW)
         M:WRITE  M:LO,(BUF,WBF2),(WAIT),(SIZE,*R6)
         B        *SUALON           RETURN TO APPROIATE RTN
SUALL    EQU      %                 CH;OME HERE AFTER SCAN
         STW,R2   ADCRSZ            SAVE THE CRITERIA SIZE
         SLS,R2   24
         STW,R2   ADCRSZ2           LEFT ADJUSTED
         LI,R5    SUALLRD           COME BACK AFTER SCAN
         STW,R5   SUALON
         M:PRINT  (MESS,SALLMS)     SUBTRACT ALL MESSAGE
         M:PFIL   F:DELX,(BOF)      REWIND FILE
SUALLRD  M:READ   F:DELX,(BUF,WBF2),(WAIT),(SIZE,ID),;
                  (ABN,LAEND)
         LI,R6    CONSNZ            MOVE THE KEY
         SLS,R6   24                KEY SIZE
         STW,R6   LSKEY
         LI,R4    BA(WBF2)          KEY NAME
         LI,R5    BA(LSKEY)+1
         OR,R5    R6                MOVE SIZE
         MBS,R4   0
         LW,R6    F:DELX+4          SET UP SIZE
         SLS,R6   -17
         LI,R15   C' '              INSURE LAST STRING IS FOUND
         STB,R15  WBF2,R6           FOUND
         B        SUALT             SAME AS REGULAR SUB
SUTSER   EQU      %                 SEE IF WE PRINT NOT FOUND
         CI,R1    0                 TEST SWITCH
         BNE      ADRDLP            READ ANOTHER
         M:PRINT  (MESS,SUNO)       NONE FOUND
         B        ADRDLP            NOW READ ANOTHER
SUNO     TEXTC    C'.....CRITERIA NOT FOUND'
SALLMS   TEXTC    C'.....SUBTRACT CRITERIA FROM ENTIRE FILE'
ASALSW   RES      1                 SPLIT VECTOR
ASONSW   RES      1                 SPLIT VECTOR FOR NAMED STN
ADIT     EQU      %                 ADD A NEW CRITERIA
         LI,R1    ADALL             ADD ALL LOCATION
         STW,R1   ASALSW            COMMON  SPLIT
         LI,R1    AONE              ADD TO NAMED STATION
         STW,R1   ASONSW
ADITC    EQU      %                 COMMON ENTRY POINT
         LW,R7    CAINCNT           TOTAL CHARACTER COUNT
         LI,R2    0                 START  POSITION FOR READS
AD1      LB,R15   WORKBF,R2         COMPUTE SIZE OF CRITERIA
         CI,R15   C' '              BLANK STOPS SCAN
         BE       ADNX              NOW BUILD STATIION NAMES
         AI,R2    1
         CI,R2    CRITER            SEE IF CRITERA SIZE IS OK
         BG       CE8               BAD CRITERIA
         CW,R2    R7                CHECK FOR ADD ALL
         BGE      *ASALSW           ADD TO ENTIRE FILE
         B        AD1               KEEP SCANNING
CE8      M:PRINT  (MESS,CE66)       BAD CRITERIA MESSAGE
         B        DRIVER
ADNX     EQU      %                 NOW DO STATIONS
         CW,R2    R7                CHECK FOR AN ENDING BLANK
         BGE      ADALL             DO ALL SINCE NO STATIONS
         STW,R2   ADCRSZ            CRITERIA SIZE RT ADJUSTED
         SLS,R2   24                CRITERIA SIZE LFT ADJUSTED
         STW,R2   ADCRSZ2
         SLS,R2   -24
         AI,R2    1                 GO TO NEXT CHARACTER
ADRDLP   EQU      %                 READ ADD LOOP
         M:SETDCB F:DELX,(ERR,LSERR)
         LW,R3    KEYINT            INITILIZE KEY
         STW,R3   LSKEY
         LW,R3    =C'    '          BLANK OUT THE REST
         STW,R3   LSKEY+1
         STW,R3   LSKEY+2
         LI,R3    1                 KEY BUILDER COUNTER
AD2      LB,R15   WORKBF,R2         GET THE STATION NAME
         AI,R2    1
         CI,R15   C' '              BLANK SEPARATES NAMES
         BE       ADRD              NOW READ IT
         CW,R2    R7                SEE IF WE ARE ALL DONE
         BG       ADRD              READ ANYTHING LEFT
         STB,R15  LSKEY,R3
         AI,R3    1                 INCREMENT KEY BUILDER
         CI,R3    CONSNZ            SEE IF KEY SIZE IS OK
         BG       LSERR             BAD STATION NAME
         B        AD2               KEEP BUILDING STATION NAME
ADCRSZ   RES      1                 CRITERIA SIZE RT ADJUSTED
ADCRSZ2  RES      1                 CRITERIA SIZE LFT ADJUSTED
ADRD     EQU      %                 READ TO ADD ROUTINE
         LW,R3    KEYINT            SEE IF ANYTHING TO READ
         CW,R3    LSKEY             ALL BLANKS ENDS IT
         BE       DRIVER            ALL DONE
         M:READ   F:DELX,(BUF,WBF2),(WAIT),(SIZE,ID),;
                  (KEY,LSKEY)
         LW,R6    F:DELX+4          CHECK SIZE
         SLS,R6   -17               ADJUST RIGHT
         LI,R15   C' '              INSERT A BLANK
         STB,R15  WBF2,R6           AFTER LAST CHARACTER
         B        *ASONSW           GO TO ADD OR SUB RTN
AONE     EQU      %                 JUST ADD ONE AT A TIME
         AI,R6    1
         LI,R5    BA(WBF2)          MOVE CRITERIA TO TAIL OF
         AW,R5    R6                JUST READ RECORD
         OR,R5    ADCRSZ2           SIZE OF CRITERIA
         LI,R4    BA(WORKBF)        LOCATION OF ADD CRITERIA
         MBS,R4   0
         AW,R6    ADCRSZ            NEW TOTAL SIZE
         M:WRITE  F:DELX,(BUF,WBF2),(WAIT),(SIZE,*R6),;
                  (KEY,LSKEY)
         M:WRITE  M:LO,(BUF,WBF2),(WAIT),(SIZE,*R6)
         M:PRINT  (MESS,ADTX)       TELL HIM WE DID IT
         B        ADRDLP            DO ANOTHER STATION
ADTX     TEXTC    C'.....ADDED'
ADALL    EQU      %                 ADD CRITERIA TO ENTIRE FILE
         M:PRINT  (MESS,ADALMS)     TELL HIM WE ADD TO ALL FILE
         STW,R2   ADCRSZ            CRITERIA SIZE
         SLS,R2   24
         STW,R2   ADCRSZ2
         SLS,R2   -24
         M:PFIL   F:DELX,(BOF)      REWIND  THE FILE
ADALRD   M:READ   F:DELX,(BUF,WBF2),(WAIT),(SIZE,ID),;
         (ABN,LAEND)
         LW,R6    F:DELX+4
         SLS,R6   -17
         LI,R15   C' '
         STB,R15  WBF2,R6           INSERT A BLANK
         AI,R6    1
         LI,R5    BA(WBF2)          MOVE CRITERIA TO TAIL
         AW,R5    R6
         AW,R6    ADCRSZ            NEW TOTAL SIZE
         OR,R5    ADCRSZ2           SIZE OF CRITERIA
         LI,R4    BA(WORKBF)
         MBS,R4   0
         LI,R4    CONSNZ            BUILD A WRITE KEY
         SLS,R4   24
         STW,R4   LSKEY
         LI,R2    BA(WBF2)          RECORD KEY LOCATION
         LI,R3    BA(LSKEY)+1
         OR,R3    R4                MOVE SIZE
         MBS,R2   0                 ASSUME IT WAS BLANK FILLED
         M:WRITE  F:DELX,(BUF,WBF2),(WAIT),(SIZE,*R6),;
                  (KEY,LSKEY)
         B        ADALRD            READ ANOTHER
LAEND    M:PRINT  (MESS,LAMSG)
         B        DRIVER
LAMSG    TEXTC    C'.....ENTIRE DELX FILE READ'
ADALMS   TEXTC    C'.....ADD CRITERIA TO ENTIRE FILE'
LS       EQU      %                 LIST A STATION OR STATIONS
         LW,R7    CAINCNT           GET COUNT
         BGZ      LSOME             LIST NAMED FILE(S)
         M:PFIL   F:DELX,(BOF)      REWIND THE DELX FILE
LSRDLP   M:READ   F:DELX,(BUF,WBF2),(WAIT),(SIZE,ID),;
                  (ABN,LAEND)
         LW,R7    F:DELX+4          JUST READ SIZE
         SLS,R7   -17
         M:WRITE  M:LO,(BUF,WBF2),(WAIT),(SIZE,*R7)
         B        LSRDLP            READ LCOP
WBF2     RES,1    ID                READ IN AREA
LSKEY    RES      3                 KEY FOR READING
KEYINT   GEN,8,24 CONSNZ,C'   '     INITILIZE KEY
LSOME    EQU      %                 LIST NAMED STATION(S)
         M:SETDCB F:DELX,(ERR,LSERR) NOT FOUND KEY
         LI,R2    0                 ASSUME X7 HAS COUNT
LSSMLP   LW,R1    KEYINT            INITILIZE THE KEY
         STW,R1   LSKEY
         LW,R1    =C'    '          BLANK OUT THE REST
         STW,R1   LSKEY+1
         STW,R1   LSKEY+2
         LI,R3    1                 KEY CHAR BUILDER COUNTER
LSMV     LB,R15   WORKBF,R2         MOVE THE KEY
         AI,R2    1
         CI,R15   C' '              BLANK SEPARATES KEYS
         BE       LSSRD             NOW READ IT
         STB,R15  LSKEY,R3
         AI,R3    1
         CI,R3    CONSNZ+1          CHECK KEY SIZE
         BG       LSERR             ERROR BAD KEY
         CW,R2    R7                SEE IF WE ARE DONE
         BE       LSSRD             GET LAST ENTRY
         BG       DRIVER            ALL DONE
         B        LSMV              KEEP BUILDING
LSSRD    EQU      %                 READ ROUTING
         LW,R8    LSKEY             SEE IF THERE IS SOMETHING
         CW,R8    KEYINT
         BE       DRIVER            NOPE SO RETURN
         M:READ   F:DELX,(BUF,WBF2),(WAIT),(SIZE,ID),;
                  (KEY,LSKEY)
         LW,R8    F:DELX+4          GET JUST READ SIZE
         SLS,R8   -17               ADJUST IT
         M:WRITE  M:LO,(BUF,WBF2),(WAIT),(SIZE,*R8)
         B        LSSMLP            DO NEXT
LSERR    M:PRINT  (MESS,LSERMS)     BAD KEY MESSAGE
         M:PRINT  (MESS,LSKEY)
         B        LSSMLP            DO ANOTHER
LSERMS   TEXTC    C'*****FOLLOWING LOGICAL STN NOT FOUND'
DE       EQU      %                 DELETE A LOGICAL STATION
         LW,R1    KEYINT            BLANK OUT THE KEY
         STW,R1   KEY
         LW,R1    =C'    '
         STW,R1   KEY+1
         STW,R1   KEY+2
         LI,R2    BA(WORKBF)        LOCATION OF THE KEY
         LI,R3    BA(KEY)+1
         LW,R4    CAINCNT           SIZE OF A KEY
         SLS,R4   24                ALIGN IT
         OR,R3    R4                SET SIZE
         MBS,R2   0
         M:SETDCB F:DELX,(ABN,CE7)
         M:DELREC F:DELX,(KEY,KEY)
         M:PRINT  (MESS,DEOK)       TELL WE DID IT
         B        DRIVER
DEOK     TEXTC    C'.....DELETED'
CE7      M:PRINT  (MESS,CE77)
         B        INBD              PRINT OUT ERRONIOUS TEXT
CE77     TEXTC    C'*****DELETE STATION NOT FOUND'
IN       EQU      %                 INSERT A LOGICAL STATION
         LW,R7    CAINCNT           CHECK ON RECORD SIZE
         LI,R6    CONSNZ+1          GET STARTING LOC OF CRITERIA
INSK     LI,R8    0                 ZERO OUT CRITERIA COUNTER
INCK     LB,R15   WORKBF,R6         START SCANNING CHARACTERS
         AI,R6    1                 INCREMENT CHARACTER COUNTER
         AI,R8    1                 INCREMENT CRITERIA COUNTER
         CI,R8    CRITER            ERROR IF CRITERIA TOO LARGE
         BG       CE6
         CW,R6    R7                SEE IF WE ARE DONE
         BG       INCKDN            ALL DONE
         CI,R15   C' '              BLANK ENDS A CRITERIA
         BE       INSK              RESET X R  8
         B        INCK              KEEP SCANNING
INCKDN   EQU      %                 THE RECORD LOOK OK
         LI,R2    BA(WORKBF)        NOW BUILD A KEY
         LI,R3    BA(KEY)+1
         LI,R4    CONSNZ            MOVE IT TO THE KEY LOCATION
         SLS,R4   24
         OR,R3    R4
         MBS,R2   0
         M:SETDCB F:DELX,(ABN,CE4)
         M:WRITE  F:DELX,(BUF,WORKBF),(WAIT),(KEY,KEY),;
                  (NEWKEY),(SIZE,*CAINCNT)
         M:PRINT  (MESS,INOK)
INBD     M:WRITE  M:LO,(BUF,WORKBF),(WAIT),(SIZE,*CAINCNT)
         B        DRIVER
KEY      GEN,8,24  CONSNZ,0
         RES      2
CE4      M:PRINT  (MESS,CE44)
         B        DRIVER
CE44     TEXTC    C'*****LOGICAL STATION ALREADY EXISTS'
CE6      M:PRINT  (MESS,CE66)
         B        INBD              PRINT OUT STATION IMABE
CE66     TEXTC    C'*****INVALID CRITERIA SPECIFIED'
INOK     TEXTC    C'.....INSERTED'
CABLNK   TEXT     C'                                         '
         TEXT     C'                                    '
CALINK   RES      1                 RETURN LINKAGE
CAINCNT  RES      1                 NUMBER OF CHARACTERS
CATYPE   RES      1                 TYPE OF DIRECTIVE
CDSV2    RES      1                 SAVE X R 2 HERE
CAWBF    RES,1    MAXCHAR*4         READ IN AREA
CARD     EQU      %                 READ ROUTING FOR DIR DATA
         STW,R1   CALINK            SAVE LINKAGE
DELCD    EQU      %
         LI,R4    0
         STW,R4   CATYPE            INITILIZE WITH ZERO DIRECTIVE
         LI,R2    BA(CABLNK)        BLANK OUT READ-IN AREA
         LI,R3    BA(WORKBF)
         OR,R3    =X'0F000000'      ABOUT F  CHARACTERS
         MBS,R2   0
         M:READ   M:SI,(BUF,CAWBF),(SIZE,MAXCHAR),(WAIT),;
                  (ABN,PAU)
         LW,R7    M:SI+4            GET SIZE
         SLS,R7   -17               ADJUST IT RIGHT
         CI,R7    72                CHECK FOR A CARD
         BLE      %+2               IGNOR LAST CHARACTER
         LI,R7    73
         AI,R7    -1                FOR A TTY
         CI,R7    0
         BLEZ     CDDONE            ALL DONE IF NOTHING
         LB,R15   CAWBF,R7          FOR SI FILE
         CI,R15   X'40'
         BL       %+2               NOT SI FILE
         AI,R7    1
         LI,R5    BA(CABLNK)        CHECK FOR BLANK CARD
         LI,R4    BA(CAWBF)
         SLS,R7   24                COMPARE JUST READ CHARACTER
         OR,R5    R7
         SLS,R7   -24
         CBS,R4   0
         BE       CDDONE            ALL THRU FOR THIS ONE
         LI,R2    0                 START PLUCKING CHARACTERS
CDDIR    EQU      %                 NOW BUILD AND CHECK DIRECTIVE
         LB,R15   CAWBF,R2          GET A CHARACTER
         CI,R15   C' '              ALL DONE WITH IT
         BLE      CD1               GO CHECK FOR A SQUEEZE FLAG
         OR,R15   =X'40'            MAKE IT ALL UPPER CASE
         STB,R15  CAWBF,R2          SAVEIT
         AI,R2    1                 NEXT POSITION
         CW,R2    R7                ARE WE DONE WITH THIS IMAGE
         BL       CDDIR             NOPE MOVE MORE
CD1      LI,R15   C' '              MAKE SURE LAST CHARACTER IS
         STB,R15  CAWBF,R2          BLANK
         LI,R1    0                 USED TO SPIN THRU VERBS
         STW,R2   CDSV2
CDLOP    LI,R4    BA(CAWBF)         JUST READ DIRECTIVE
         LW,R2    CDVERB,R1         GET FIRST VERB POINTER
         LW,R5    R2                GET BA OF DIRECTIVE
         AI,R5    1                 SKIP PAST COUNT
         AND,R5   =X'00FFFFFF'      JUST WANT BA
         SLS,R2   -2                NOW FETCH ACTUAL COUNT
         LW,R6    *R2               FOR A COMPARE SIZE ARGUMENT
         AND,R6   =X'FF000000'      CLEAN UP CHARACTERS
         OR,R5    R6                SET TO DO A COMPARE
         CBS,R4   0
         BE       CDFND             GOT A LEGAL DIRECTIVE
         AI,R1    1                 GO TO NEXT
         CI,R1    CDVBEND-CDVERB    MORE TO DO
         BL       CDLOP             MORE
         LI,R4    BA(CAWBF)         CHECK FOR DEL CARD
         LI,R5    BA(DELC)
         OR,R5    =X'06000000'
         CBS,R4   0
         BE       DELCD
CE1      M:PRINT  (MESS,CE11)       BAD DIRECTIVE
         B        DRIVER
CE11     TEXTC    C'*****INVALID DIRECTIVE SPECIFIED'
DELC     TEXT     C' DELUT'
READ%IN%PROGRESS DATA 0             READ IN PROGRESS SWITCH
CDVERB   GEN,8,24 1,BA(CB1)         LIST DIRECTIVE
         GEN,8,24 1,BA(CB2)         LIST
         GEN,8,24 2,BA(CB3)         MATCH
         GEN,8,24 2,BA(CB4)         MATCH
         GEN,8,24 3,BA(CB5)         INSERT
         GEN,8,24 3,BA(CB6)         INSER
         GEN,8,24 4,BA(CB7)         DELETE
         GEN,8,24 4,BA(CB8)         DELETE
         GEN,8,24 5,BA(CB9)         ADD
         GEN,8,24 6,BA(CB10)        SUBTRACT
         GEN,8,24 6,BA(CB11)        SUBTRACT
         GEN,8,24 7,BA(CB12)        FOR END VERB
CDVBEND  EQU      %                 END OF THE LIST
CB1      TEXTC    C'LIST '
CB2      TEXTC    C'LIS '
CB3      TEXTC    C'MATCH '
CB4      TEXTC    C'MAT '
CB5      TEXTC    C'INSERT '
CB6      TEXTC    C'INS '
CB7      TEXTC    C'DELETE '
CB8      TEXTC    C'DEL '
CB9      TEXTC    C'ADD '
CB10     TEXTC    C'SUBTRACT '
CB11     TEXTC    C'SUB '
CB12     TEXTC    C'END'            FOR END VERB
CDFND    EQU      %                 GOT A VALID HIT
         MTW,1    READ%IN%PROGRESS   WE ARE PROCESSING A GOOD RECORD
         LW,R4    CDVERB,R1         NOW SAVE THE TYPE
         SLS,R4   -24               JUSTIFY RIGHT
         STW,R4   CATYPE            SAVE TYPE
         LI,R4    0                 INITILIZE CHARACTER COUNT
         STW,R4   CAINCNT
         LW,R2    CDSV2             RESTORE OUT CURRENT POSITION
         LI,R5    0
CDFN     AI,R2    1                 START GETTING DATA
         CW,R2    R7                IMAGES
         BGE      CDRD              READ ANOTHER IMAGE
CDFND1   LB,R15   CAWBF,R2          GET ANOTHER CHARACTER
         CI,R15   C' '              CHECK FOR A BLANK TO SQUEEZ
         BE       CDOK              CHECK IF WE WANT TO SQUEEZE
         LI,R5    0                 SET NO SQUEEZE FLAG
         CI,R15   C';'              IGNOR REST OF LINE OR CARD
         BE       CDRD              READ ANOTHER IMAGE
         STB,R15  WORKBF,R4         SAVE THE CHARACTER
         AI,R4    1                 INCREMENT FOR NEXT TIME
         CI,R4    ID                SEE IF BUFFER IS FULL
         BLE      CDFN              NOPE MORE ROOM AVAILABLE
CE2      M:PRINT  (MESS,CE22)       BUFFER FILL MESSAGE
         MTW,-1   READ%IN%PROGRESS  UNSET READ IN PROGRESS FLG
         B        DRIVER            DO ANOTHER
CE22     TEXTC    C'*****INTERNAL BUFFER FULL'
CDOK     EQU      %                 GOT A BLANK
         LW,R8    CATYPE            SEE IF IT IS AN INSERT
         CI,R8    3
         BNE      CDOK1             NOT AN INSERT
         CI,R4    CONSNZ            THIS BLANK FILLS THE STATION
         BGE      CDOK1             NAME
         CI,R4    0                 FIRST TIME THRU SO ITS A STATION
         BLE      CDOK1             SO WE WANT IT LEFT JUSTIFIED
         LI,R4    CONSNZ            THIS SKIPS THE REST
CDOK1    EQU      %                 STANDARD BLANK SQUEEZING TRICK
         EXU      CDOKS,R5          DO A STORE IF APPROIATE
         EXU      CDOKT,R5          INCREMENT IF APPROIATE
         LI,R5    1                 THIS IGNORS THE REST OF THE
         B        CDFN              BLANKS IN THIS STRING
CDOKS    STB,R15  WORKBF,R4
         NOP
CDOKT    AI,R4    1
         NOP
CDRD     M:READ   M:SI,(BUF,CAWBF),(WAIT),(SIZE,MAXCHAR),;
                  (ABN,PAU)
         LI,R2    0                 START READING AT FIRST CHAR
         LW,R7    M:SI+4            GET COUNT
         SLS,R7   -17
         CI,R7    73
         BLE      %+2               ONLY WANT FIRST 72 CHAR
         LI,R7    73
         AI,R7    -1                DELETES CR AND LF
         CI,R7    0
         BLEZ     CDDONE            ALL DONE IF NO DATA
         LB,R15   CAWBF,R7          SEE IF THIS AN SI FILE
         CI,R15   X'40'
         BL       %+2               RMC 12-13-74 FIX OLD ERROR
         AI,R7    1
         LI,R9    BA(CABLNK)        ALSO DONE IF BLANK CARD
         LI,R8    BA(CAWBF)
         SLS,R7   24
         OR,R9    R7
         SLS,R7   -24
         CBS,R8   0
         BE       CDDONE            ALL DONE
         B        CDFND1            NOW DO SOME MORE MOVING
CDDONE   EQU      %                 SAVE PROCESSED CHAR CNT
         CI,R4    0                 CHECK FOR NO DATA
         BE       CD44              ITS OK
         CI,R15   C' '              GET RID OF LAST BLANK
         BNE      CD44
         AI,R4    -1                SUBTRACT OFF LAST BLANK
CD44     STW,R4   CAINCNT
         MTW,-1   READ%IN%PROGRESS  UNSET READ IN PROGRESS FLAG
         MTW,0    READ%IN%PROGRESS  CHECK IF WE EXPECT MORE INPUT
         BEZ      DONE%OK           NOPE REALLY ALL DONE
         M:PRINT  (MESS,NOT%OK)
DONE%OK  EQU      %                 VALID END OF FILE
         B        *CALINK
CE3      EQU      %                 COMMON ERROR ROUTINE
         LW,R1    R10               CHECK STATUS
         SLS,R1   -24               FOR A NON EXISTANCE OF
         CI,R1    3                 THE F:DELX FILE
         BNE      CE3A              ITS THERE
         M:OPEN   F:DELX,(OUTIN),(SAVE),(KEYM,CONSNZ),(KEYED)
         M:CLOSE  F:DELX,SAVE
         B        DELUTL            NOW CONTINUE
CE3A     EQU      %
         M:PRINT  (MESS,CE33)
         B        PAU
CE33     TEXTC    C'*****F:DELX FILE ERROR'
PAU      EQU      %                 ALL DONE
         M:SETDCB F:DELX,(ABN,PAUALL),(ERR,PAUALL)
         M:CLOSE  F:DELX,SAVE
PAUALL   M:EXIT
PATCH    RES      25                PATCH AREA
NOT%OK   TEXTC    C'*****UNEXPECTED END OF FILE REACHED ON INPUT'
         END      DELUTL

