PURGALL 
          IDENT  PURGALL,FETS 
          ABS 
          SST 
          SYSCOM B1 
          ENTRY  PURGALL
          ENTRY  RFL= 
          TITLE  PURGALL - PURGE ALL PERMANENT FILES. 
*COMMENT  PURGALL - PURGE ALL PERMANENT FILES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       PURGALL - PURGE ALL PERMANENT FILES.
*         V. A. WALSH.       72/08/15.
*         B. G. ALBRECHT     88/01/22.
          SPACE  4,10 
***       PURGALL PERFORMS A PURGE ON ALL PERMANENT FILES THAT
*         SATISFY THE CRITERIA ESTABLISHED BY THE ARGUMENTS.
*         ONLY THOSE FILES WHICH MEET ALL OF THE SPECIFIED
*         SELECTION CRITERIA WILL BE PURGED.
* 
*         CONTROL CARD FORMAT - 
* 
*         PURGALL(AD=DATE,AF,CD=DATE,CT=FC,DF,DN=NN,EF=E1/E2/../EN, 
*         FN=F1/F2/.../FN,MD=DATE,NA,PN=PACKNAM,R=XX,TM=TIME,TY=FT,WB)
* 
*                AD = ACCESS DATE.
*                     FORMAT = YYMMDD 
*                     YY - LAST TWO DIGITS OF YEAR. 
*                     MM - MONTH. 
*                     DD - DAY. 
* 
*                AF = AFTER FLAG.  IF SET, FILES WITH 
*                     CREATION, LAST ACCESS OR LAST 
*                     MODIFICATION DATE AFTER THAT SPECIFIED
*                     BY THE CD, AD, OR MD PARAMETER WILL 
*                     BE PROCESSED.  OTHERWISE, FILES WITH
*                     DATES BEFORE THAT WILL BE PROCESSED.
* 
*                CD = CREATION DATE.
*                     FORMAT = YYMMDD 
*                     YY - LAST TWO DIGITS OF YEAR. 
*                     MM - MONTH. 
*                     DD - DAY. 
* 
*                CT = FILE CATEGORY.
*                     OPTION   -   SHORT FORM - DESCRIPTION 
*                     PRIVATE           P       ALL PRIVATE FILES.
*                                       PR
*                     SPRIV             S       ALL SEMI-PRIVATE FILES. 
*                                       SP
*                     PUBLIC            PU      ALL PUBLIC FILES. 
*                     LIBRARY           L       ALL LIBRARY FILES.
*                                       LI
* 
*                DN = DEVICE NUMBER.
*                     RANGE = (1 - 77B).
* 
*                DF = DAYFILE FLAG.  IF SET, A DAYFILE MESSAGE WILL 
*                     BE ISSUED FOR EACH FILE PURGED. 
* 
*                EF = FILENAME/FILENAME/.../FILENAME. 
*                     EXCLUDED PERMANENT FILENAME.  THIS PARAMETER
*                     EXCLUDES FROM PURGING THESE PERMANENT FILE
*                     NAMES.
* 
*                     AN ASTERISK (*) PRESENT IN A FILE NAME
*                     INDICATES THAT A SET OF FILES IS TO BE
*                     EXCLUDED.  FOR EXAMPLE, EF=***OPL WILL EXCLUDE
*                     FROM PURGING ALL THE FILES WITH SIX CHARACTER 
*                     NAMES THAT END IN *OPL*; EF=M****** WILL
*                     EXCLUDE FROM PURGING ALL THE FILES WITH NAMES 
*                     THAT START WITH THE LETTER *M*. 
* 
*                     MULTIPLE FILE NAMES MAY BE SPECIFIED, SEPARATED 
*                     BY SLASHES; FOR EXAMPLE,
*                     EF=A******/B******/C****** WILL EXCLUDE FROM
*                     PURGING ALL THE FILES WITH NAMES THAT BEGIN 
*                     WITH THE LETTERS *A*, *B* OR *C*. 
* 
*                     THE *EF* PARAMETER MAY BE SPECIFIED TOGETHER
*                     WITH THE *FN* PARAMETER; FOR EXAMPLE, 
*                     FN=AB*****,EF=ABC**** WILL PURGE ALL THE FILES
*                     WITH NAMES THAT START WITH THE LETTERS *AB*,
*                     EXCEPT FOR THOSE FILES WITH NAMES THAT START
*                     WITH THE LETTERS *ABC*. 
* 
*                FN = FILENAME/FILENAME/.../FILENAME. 
*                     PERMANENT FILENAME.  THIS PARAMETER RESTRICTS 
*                     THE PURGE TO THESE PERMANENT FILE NAMES.
* 
*                     AN ASTERISK (*) PRESENT IN A FILE NAME
*                     INDICATES THAT A SET OF FILES IS TO BE PURGED.
*                     FOR EXAMPLE, FN=***OPL WILL PURGE ALL THE FILES 
*                     WITH SIX CHARACTER NAMES THAT END IN *OPL*; 
*                     FN=M****** WILL PURGE ALL THE FILES WITH NAMES
*                     THAT START WITH THE LETTER *M*. 
* 
*                     MULTIPLE FILE NAMES MAY BE SPECIFIED, SEPARATED 
*                     BY SLASHES; FOR EXAMPLE,
*                     FN=A******/B******/C****** WILL PURGE ALL THE 
*                     FILES WITH NAMES THAT BEGIN WITH THE LETTERS
*                     *A*, *B* OR *C*.
* 
*                     THE *EF* PARAMETER MAY BE SPECIFIED TOGETHER
*                     WITH THE *FN* PARAMETER; FOR EXAMPLE, 
*                     FN=AB*****,EF=ABC**** WILL PURGE ALL THE FILES
*                     WITH NAMES THAT START WITH THE LETTERS *AB*,
*                     EXCEPT FOR THOSE FILES WITH NAMES THAT START
*                     WITH THE LETTERS *ABC*. 
* 
*                MD = MODIFICATION DATE.
*                     FORMAT = YYMMDD 
*                     YY - LAST TWO DIGITS OF YEAR. 
*                     MM - MONTH. 
*                     DD - DAY. 
* 
*                NA = NO ABORT. IF SET, JOB WILL NOT ABORT
*                     IF ERROR ENCOUNTERED WHILE PURGING.  *NA* CANNOT
*                     BE SPECIFIED TOGETHER WITH *WB*.
* 
*                PN = PACK NAME.
*                     ONLY FILES ON SPECIFIED PACK
*                     WILL BE PROCESSED.
* 
*                R = RESIDENCE. DEVICE TYPE FOR PACK REQUESTS.
* 
*                TM = TIME OF DAY.
*                     FORMAT = HHMMSS 
*                     HH - HOUR.
*                     MM - MINUTE.
*                     SS - SECOND.
* 
*                TY = FILE TYPE.
*                     OPTION   -   SHORT FORM - DESCRIPTION 
*                     INDIR             I       ALL INDIRECT FILES. 
*                     DIRECT            D       ALL DIRECT FILES. 
*                     ALL               A       ALL FILES. (DEFAULT)
* 
*                WB = WAIT BUSY.  IF SET, JOB WILL WAIT FOR PACK
*                     MOUNT, BUT WILL ABORT IF AN ERROR IS
*                     ENCOUNTERED.  *WB* CANNOT BE SPECIFIED TOGETHER 
*                     WITH *NA*.
* 
*         ONLY ONE OF THE OPTIONS AD, MD, OR CD MAY BE ENTERED. 
*         THE TM AND AF OPTIONS MUST BE ACCOMPANIED BY A DATE OPTION
*         (AD, CD, OR ND).
* 
*         ASSUMED - 
*                TY = ALL IF OTHER OPTION(S) PRESENT. 
*                TM = 000000 IF DATE SPECIFIED. 
          SPACE  4,10 
***       DAYFILE MESSAGES -
* 
*         * EMPTY CATALOG.* = NO PERMANENT FILES IN THE CATALOG.
* 
*         * ERROR IN ARGUMENTS.* = AN INVALID PARAMETER OR COMBINATION
*                OF PARAMETERS WAS SPECIFIED. 
* 
*         * ERROR IN DATE.* = FORMAT OF DATE INCORRECT. 
* 
*         * ERROR IN DEVICE NUMBER.* = DEVICE NUMBER NOT IN RANGE(1-77B)
*                OR SPECIFIED WITH THE PN OR R PARAMETER. 
* 
*         * ERROR IN FILE CATEGORY.* = FILE CATEGORY NOT LEGAL. 
* 
*         * ERROR IN FILE TYPE.* = FILE TYPE NOT LEGAL. 
* 
*         * ERROR IN TIME.* = FORMAT OF TIME INCORRECT. 
* 
*         * NO FILES PURGED.* = WHEN NO FILES ARE PURGED. 
* 
*         * PURGALL ABORTED.* = PURGALL TERMINATED ABNORMALLY.
* 
*         * PURGALL COMPLETE.* = PURGALL TERMINATED NORMALLY. 
* 
*         * PURGING FFFFFFF* = MESSAGE ISSUED AS EACH FILE IS PURGED, 
*                IF THE *DF* PARAMETER IS SPECIFIED.
* 
*         * XXXXXXX OF YYYYYYY FILES PURGED.* = XXXXXXX FILES PURGED
*                OUT OF A TOTAL OF YYYYYYY FILES IN THE CATALOG.
          SPACE  4,10 
*         ASSEMBLY CONSTANTS. 
  
  
 BUFL     EQU    1001B
          TITLE  STORAGE ASSIGNMENT.
          ORG    110B 
          SPACE  4,15 
*         FETS. 
  
 FETS     BSS    0
 F        BSS    0
 FILE     FILEB  BUF,BUFL,(FET=14)
 P        BSS    0
 PFILE    FILEB  BUF,BUFL,(FET=14)
 .P       BSS    0
          ORG    P+1         SUPPRESS ADDRESS ON *PFM* ERRORS 
          VFD    13/0,1/1,22/0,6/14-5,18/BUF
          ORG    .P 
          SPACE  4,10 
*         PARAMETER FLAG LOCATIONS. 
  
 ACDT     BSSZ   1           ACCESS DATE FLAG 
 CRDT     BSSZ   1           CREATION DATE FLAG 
 DFMS     CON    3           DAYFILE MESSAGE VALUE (USER DAYFILE) 
 DFOP     CON    1           DAYFILE MESSAGE OPTION (DEFAULT = *MS1W*)
 DVNM     BSSZ   1           DEVICE NUMBER FLAG 
 FLCT     BSSZ   1           FILE CATEGORY
 FLTY     BSSZ   1           FILE TYPE
 MDDT     BSSZ   1           MODIFICATION DATE
 PKNM     BSSZ   1           PACK NAME
 TIME     BSSZ   1           TIME OF DAY
 NABT     BSSZ   1           NO ABORT FLAG
 RES      BSSZ   1           RESIDENCE
 AFTR     BSSZ   1           AFTER FLAG 
 FLNM     BSS    0           SELECTION FILE NAME LIST 
          CON    7L*******   DEFAULT FILE NAME SELECTION MASK 
          BSSZ   35 
 EFNM     BSS    0           EXCLUSION FILE NAME LIST 
          BSSZ   36 
 WBSY     CON    0           WAIT BUSY FLAG 
 NZ       CON    1           NONZERO VALUE
          SPACE  4,15 
*         MISCELLANEOUS PROGRAM DATA. 
  
 MESC     DATA   C* XXXXXXX OF YYYYYYY FILES PURGED.*  DAYFILE MESSAGE
 MESD     DATA   C* PURGING    *  DISPLAY MESSAGE 
 PGCT     CON    0           COUNT OF FILES PURGED
 TLFC     CON    0           TOTAL FILE COUNT 
 ABFG     CON    0           NON-ZERO IF ABORT IN PROGRESS
          SPACE  4,10 
*         MACRO DEFINITIONS.
  
*CALL     COMCMAC 
*CALL     COMSPFM 
          TITLE  MAIN PROGRAM.
 PURGALL  SPACE  4,10 
**        PURGALL - PURGE ALL PERMANENT FILES.
  
  
 PURGALL  BSS    0           ENTRY
          RJ     PRS         PRESET PROGRAM 
          EREXIT PRG12       SET ERROR EXIT ADDRESS 
  
*         GET NEXT BUFFER OF CATALOG ENTRIES. 
  
 PRG1     SA1    F+1         SET IN=OUT=FIRST 
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          CATLIST F,,,,,RES,,DN 
          SA1    F
          MX0    -8 
          AX1    10 
          BX1    -X0*X1 
          ZR     X1,PRG2     IF NO *PFM* ERROR
          SA1    NABT 
          ZR     X1,PRG12    IF *NO ABORT* NOT SPECIFIED
 PRG2     SA3    F+2         CHECK IF BUFFER EMPTY
          SA2    A3+B1
          BX2    X3-X2
          ZR     X2,PRG13    IF EMPTY CATALOG 
  
*         GET NEXT FILE NAME. 
  
 PRG3     READW  F,PBUF,NWCE
          PL     X1,PRG4     IF NOT END OF BUFFER 
          SA1    F
          LX1    59-9 
          PL     X1,PRG1     IF NOT END OF CATLIST
          EQ     PRG13       ISSUE TERMINATION MESSAGES 
  
*         INCREMENT TOTAL FILE COUNT. 
  
 PRG4     SA1    TLFC        INCREMENT FILE COUNT 
          SX6    X1+B1
          SA6    A1 
          SA2    PBUF        GET FIRST ENTRY
  
*         CHECK FILE TYPE.
  
          SA1    FLTY 
          ZR     X1,PRG6     IF NOT SET 
          SA4    A2+FCBS     GET FILE TYPE
          LX4    59-11
          SX1    X1-1 
          ZR     X1,PRG5     IF INDIRECT WANTED 
          NG     X4,PRG6     IF CORRECT FILE TYPE 
          EQ     PRG3        GET NEXT FILE NAME 
  
 PRG5     NG     X4,PRG3     IF NOT CORRECT FILE TYPE 
  
*         CHECK FILE CATEGORY.
  
 PRG6     SA1    FLCT 
          ZR     X1,PRG8     IF NOT SET 
          SA4    A2+FCCT     GET FILE CATEGORY
          AX4    54 
          LX1    59-17
          PL     X1,PRG7     IF NOT PRIVATE 
          ZR     X4,PRG8     IF CORRECT CATEGORY
          EQ     PRG3        GET NEXT FILE NAME 
  
 PRG7     LX1    18 
          BX6    X1-X4
          NZ     X6,PRG3     IF NOT CORRECT CATEGORY
  
*         CHECK ACCESS DATE AND TIME. 
  
 PRG8     SA1    ACDT 
          ZR     X1,PRG9     IF NOT SET 
          SA4    A2+FCAD     GET ACCESS DATE AND TIME 
          RJ     CDT         COMPARE DATE AND TIME
          PL     X6,PRG3     IF NOT CORRECT ENTRY 
  
*         CHECK CREATION DATE AND TIME. 
  
 PRG9     SA1    CRDT 
          ZR     X1,PRG10    IF NOT SET 
          SA4    A2+FCCD     GET CREATION DATE AND TIME 
          RJ     CDT         COMPARE DATE AND TIME
          PL     X6,PRG3     IF NOT CORRECT ENTRY 
  
*         CHECK MODIFICATION DATE AND TIME. 
  
 PRG10    SA1    MDDT 
          ZR     X1,PRG11    IF NOT SET 
          SA4    A2+FCMD     GET MODIFICATION DATE AND TIME 
          RJ     CDT         COMPARE DATE AND TIME
          PL     X6,PRG3     IF NOT CORRECT ENTRY 
  
*         CHECK FILENAME MATCH. 
  
 PRG11    SA3    A2+FCFN     GET FILENAME 
          SB2    FLNM        CHECK INCLUSION LIST 
          RJ     CFN
          NZ     X6,PRG3     IF FILE NOT IN INCLUSION LIST
          SB2    EFNM        CHECK EXCLUSION LIST 
          RJ     CFN
          ZR     X6,PRG3     IF FILE IN EXCLUSION LIST
  
*         PURGE FILE. 
  
          SX6    3
          MX0    42 
          BX7    X0*X2
          BX6    X6+X7
          SA7    MESD+1 
          SA6    P
          SA2    DFOP 
          MESSAGE A7-B1,X2
          SA1    PGCT        INCREMENT PURGE COUNT
          SX6    X1+B1
          SA6    A1 
          PURGE  P,,,,RES 
          SA1    P
          MX0    -8 
          AX1    10 
          BX1    -X0*X1 
          ZR     X1,PRG3     IF NO *PFM* ERROR
          SA1    NABT 
          NZ     X1,PRG3     IF *NO ABORT* SPECIFIED
 PRG12    SX6    1           SET ABORT IN PROGRESS FLAG 
          SA6    ABFG 
  
*         ISSUE TERMINATION MESSAGES. 
  
 PRG13    SA2    PGCT        POST MESSAGES
          SA5    TLFC 
          SX1    =C* EMPTY CATALOG.*
          ZR     X5,PRG14    IF NO FILES
          SX1    =C* NO FILES PURGED.*
          ZR     X2,PRG14    IF NO FILES PURGED 
          BX1    X2          CONVERT NUMBER OF FILES PURGED 
          RJ     CDD
          MX6    1           GENERATE MASK FOR DIGITS CONVERTED 
          SB2    B2-B1
          AX6    B2 
          BX1    X6*X4       REMOVE BLANKS
          SB2    1RX         SUBSTITUTION CHARACTER 
          SB5    MESC        MESSAGE ADDRESS
          RJ     SNM         SET NAME INTO MESSAGE
          BX1    X5          CONVERT NUMBER OF FILES BEFORE PURGE 
          RJ     CDD
          MX6    1           GENERATE MASK FOR DIGITS CONVERTED 
          SB2    B2-B1
          AX6    B2 
          BX1    X6*X4       REMOVE BLANKS
          SB2    1RY         SUBSTITUTION CHARACTER 
          SB5    MESC        MESSAGE ADDRESS
          RJ     SNM         SET NAME IN MESSAGE
          SX1    MESC 
 PRG14    MESSAGE X1,3
          SA1    ABFG        CHECK IF ABORT IN PROGRESS 
          NZ     X1,PRG16    IF ABORT REQUIRED
          SA1    JOPR 
          MX0    -12
          LX1    -24
          BX1    -X0*X1 
          SX1    X1-IAOT
          ZR     X1,PRG15    IF INTERACTIVE JOB 
          MESSAGE (=C* PURGALL COMPLETE.*),3
 PRG15    ENDRUN
  
 PRG16    MESSAGE (=C* PURGALL ABORTED.*) 
          ABORT 
          TITLE  SUBROUTINES. 
 CDT      SPACE  4,10 
**        CDT - COMPARE DATE AND TIME.
* 
*         ENTRY  (X1) = DATE FROM CONTROL STATEMENT.
*                (X4) = DATE/TIME FROM CATALOG ENTRY. 
* 
*         EXIT   (X6) .LT. 0 IF FILE MEETS DATE/TIME CRITERIA.
* 
*         USES   A - 3, 5.
*                X - 0, 1, 3, 4, 5, 6.
  
  
 CDT1     IX6    X1-X4
  
 CDT      SUBR               ENTRY/EXIT 
          MX0    -36
          BX4    -X0*X4      ISOLATE DATE/TIME
          SA5    TIME 
          LX1    18 
          BX1    X1+X5       CONTROL STATEMENT DATE/TIME
          SA3    AFTR 
          NZ     X3,CDT1     IF AFTER FLAG SET
          IX6    X4-X1
          EQ     CDTX        RETURN 
 CFN      SPACE  4,15 
**        CFN - CHECK FILENAME IN LIST. 
* 
*         *CFN* CHECKS A FILE NAME FOR INCLUSION IN A LIST, 
*         WITH WILDCARD MATCHING. 
* 
*         ENTRY  (X3) = FILENAME. 
*                (B2) = FWA OF LIST.
* 
*         EXIT   (X6) = 0 IF FILE IN LIST.
* 
*         USES   X - 1, 3, 4, 5, 6, 7.
*                A - 1, 4, 5. 
*                B - 2. 
  
  
 CFN2     SX6    B1+
  
 CFN      SUBR               ENTRY/EXIT 
          MX7    42 
          BX3    X7*X3
 CFN1     SA4    B2 
          SB2    B2+B1
          ZR     X4,CFN2     IF END OF LIST 
          SA1    CFNA        CHARACTER MASK 
          SA5    CFNB        ASTERISKS
          BX5    X4-X5
          BX6    X1*X5
          BX7    -X1*X5 
          IX6    X1+X6
          BX6    X6+X7
          BX7    -X1*X6 
          BX6    X7 
          LX7    -5 
          IX7    X6-X7
          BX7    X6+X7
          BX6    X4-X3
          BX6    X7*X6
          ZR     X6,CFNX     IF IN LIST 
          EQ     CFN1        CHECK NEXT ENTRY IN LIST 
  
  
 CFNA     CON    37373737373737000000B
 CFNB     CON    7L*******
          TITLE  COMMON DECKS AND BUFFERS.
*         COMMON DECKS. 
  
  
*CALL     COMCCDD 
*CALL     COMCCPM 
*CALL     COMCCIO 
*CALL     COMCPFM 
*CALL     COMCRDW 
*CALL     COMCSNM 
*CALL     COMCSYS 
          SPACE  4,10 
*         BUFFER ASSIGNMENTS. 
  
  
          USE    BUFFERS
 PBUF     EQU    *           WORKING BUFFER 
 BUF      EQU    PBUF+NWCE   CATLIST BUFFER 
 RFL=     EQU    BUF+BUFL 
          TITLE  PRESET.
 PRS      SPACE  4,10 
          ORG    BUF+1
**        PRESET PROGRAM. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          SB1    1
          SA1    ACTR 
          SB4    X1 
          ZR     B4,PRS8     IF NO ARGUMENTS
          SA4    ARGR        SET FIRST ARGUMENT 
          ZR     X4,PRS8     IF ZERO ARGUMENT 
          SB5    TARG 
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,PRS8     IF ERROR 
  
*         CHECK FILE CATEGORY.
  
          SA1    FLCT 
          ZR     X1,PRS1     IF NOT SET 
          SA2    TFLCT
          RJ     OPT         CHECK OPTION 
          ZR     X2,PRS9     IF ERROR 
  
*         CHECK FILE TYPE.
  
 PRS1     SA1    FLTY 
          ZR     X1,PRS2     IF NOT SET 
          SA2    TFLTY
          RJ     OPT         CHECK OPTION 
          ZR     X2,PRS10    IF ERROR 
  
*         CHECK DEVICE NUMBER.
  
 PRS2     SA5    DVNM 
          ZR     X5,PRS3     IF NOT SET 
          SB7    B0 
          RJ     DXB
          NZ     X4,PRS11    IF ERROR 
          SX2    X6-100B
          PL     X2,PRS11    IF OUT OF RANGE
          LX6    12 
          SA6    F+CFOU      SET DEVICE NUMBER IN FET 
  
*         CHECK DATES.
  
 PRS3     SX6    0           INITIALIZE DATE CONVERSION 
          SA1    ACDT        ACCESS DATE
          RJ     CHK         CHECK DATE 
          SA1    CRDT        CREATION DATE
          RJ     CHK         CHECK DATE 
          SA1    MDDT        MODIFICATION DATE
          RJ     CHK         CHECK DATE 
  
*         CHECK AFTER FLAG. 
  
          SA5    AFTR 
          ZR     X5,PRS4     IF AFTER FLAG NOT SET
          ZR     X6,PRS8     IF DATE NOT SET
  
*         CHECK TIME OF DAY.
  
 PRS4     SA1    TIME 
          ZR     X1,PRS7     IF TIME NOT SET
          ZR     X6,PRS8     IF DATE NOT SET
          SA3    VDTA        GET BASE DATE/TIME (TODAY) 
          AX3    18 
          BX6    X6-X3
          ZR     X6,PRS5     IF DATE IS TODAY 
          SX2    23S12+59S6+60  SET BASE TIME TO 23.59.60 
          LX3    18 
          BX6    X3+X2       RESET BASE DATE/TIME 
          SA6    A3 
 PRS5     SX2    B1          INDICATE TIME PROCESSING 
          RJ     VDT         VALIDATE/CONVERT TIME
          NG     X6,PRS13    IF ERROR IN TIME 
          PL     X1,PRS13    IF TIME LATER THAN CURRENT TIME
          SA6    TIME 
  
*         CHECK PACK NAME.
  
 PRS7     SA5    PKNM 
          ZR     X5,PRS7.1   IF NO PACKNAME 
          SA1    DVNM 
          NZ     X1,PRS8     IF DEVICE NUMBER SET 
          BX6    X5 
          SA6    F+CFPK 
          SA6    P+CFPK 
  
*         CHECK *NO ABORT* AND *WAIT BUSY* PARAMETERS.
  
 PRS7.1   SA1    NABT 
          SA2    WBSY 
          IX1    X1+X2
          ZR     X1,PRS7.2   IF NEITHER *NA* NOR *WB* SET 
          SX2    X1-2 
          ZR     X2,PRS8     IF BOTH *NA* AND *WB* SET
          SA1    P+1         SET ERROR PROCESSING BIT 
          SX6    B1 
          LX6    44 
          BX7    X1+X6
          SA7    A1 
          SA1    F+1
          BX6    X1+X6
          SA6    A1 
  
*         CHECK RESIDENCE.
  
 PRS7.2   SA1    RES
          SA2    DVNM 
          ZR     X1,PRSX     IF NOT SET 
          NZ     X2,PRS8     IF DEVICE NUMBER SET 
          MX6    12 
          BX5    X6*X1
          LX5    12 
          SB7    X5 
          LX1    12 
          BX5    X6*X1
          ZR     X5,PRSX     IF NO UNIT COUNT 
          RJ     DXB         CONVERT TO OCTAL 
          NZ     X4,PRS8     IF ERROR 
          EQ     PRSX        RETURN 
  
 PRS8     SX2    =C* ERROR IN ARGUMENTS.* 
          EQ     PRS14
  
 PRS9     SX2    =C* ERROR IN FILE CATEGORY.* 
          EQ     PRS14
  
 PRS10    SX2    =C* ERROR IN FILE TYPE.* 
          EQ     PRS14
  
 PRS11    SX2    =C* ERROR IN DEVICE NUMBER.* 
          EQ     PRS14
  
 PRS12    SX2    =C* ERROR IN DATE.*
          EQ     PRS14
  
 PRS13    SX2    =C* ERROR IN TIME.*
  
 PRS14    MESSAGE X2
          ABORT 
  
  
*         COMMON DECKS. 
  
*CALL     COMCARG 
*CALL     COMCDXB 
*CALL     COMCVDT 
          TITLE  PRESET SUBROUTINES.
 CHK      SPACE  4,10 
**        CHK - CHECK DATE. 
* 
*         ENTRY  (X1) = DATE IN DISPLAY CODE. 
*                (A1) = ADDRESS OF DATE.
*                (X6) = PREVIOUS CONVERTED DATE OR ZERO.
* 
*         EXIT   (X6) = PACKED DATE, IF DATE SPECIFIED AND NO ERRORS. 
*                       PACKED DATE ALSO STORED AT ENTRY (A1).
*                (X6) = UNCHANGED, IF NO DATE SPECIFIED.
*                TO *PRS8* IF DATE PREVIOUSLY PROCESSED.
*                TO *PRS12* IF ERROR IN DATE VALUE. 
* 
*         USES   A - 0, 6.
*                X - 2. 
* 
*         CALLS  VDT. 
  
  
 CHK1     SA6    A0+         STORE CONVERTED DATE 
  
 CHK      SUBR               ENTRY/EXIT 
          ZR     X1,CHKX     IF NO DATE SPECIFIED.
          NZ     X6,PRS8     IF DATE PREVIOUSLY PROCESSED 
          SA0    A1          SAVE ADDRESS OF DATE 
          BX2    X2-X2       SET FOR DATE CONVERSION
          RJ     VDT         VERIFY/CONVERT DATE
          NG     X6,PRS12    IF ERROR IN DATE 
          NG     X1,CHK1     IF DATE IS BEFORE TODAY
          ZR     X1,CHK1     IF DATE IS TODAY 
          EQ     PRS12       PROCESS ERROR (DATE AFTER TODAY) 
 OPT      SPACE  4,10 
**        OPT - CHECK OPTIONS.
* 
*         ENTRY  (A1) = ADDRESS OF OPTION.
*                (X1) = OPTION. 
*                (A2) = ADDRESS OF TABLE. 
*                (X2) = FIRST TABLE ENTRY.
* 
*         EXIT   (X2) = 0 IF NOT FOUND. 
*                ((A1)) = OPTION VALUE. 
* 
*         USES   A - 2, 6.
*                B - NONE.
*                X - 0, 2, 3, 6.
  
  
 OPT      SUBR               ENTRY/EXIT 
 OPT1     ZR     X2,OPTX     IF END OF TABLE
          MX0    42 
          BX6    X1-X2
          BX3    X0*X6
          ZR     X3,OPT2     IF FOUND 
          SA2    A2+B1
          EQ     OPT1        LOOP 
  
 OPT2     BX6    -X0*X2 
          SA6    A1          SET OPTION VALUE 
          EQ     OPTX        RETURN 
          TITLE  TABLES.
 TABLES   SPACE  4,10 
*         ARGUMENT TABLE. 
  
  
 TARG     BSS    0
 AD       ARG    ACDT,ACDT
 AF       ARG    -NZ,AFTR 
 CD       ARG    CRDT,CRDT
 CT       ARG    FLCT,FLCT
 DF       ARG    -DFMS,DFOP 
 DN       ARG    DVNM,DVNM
 EF       ARG    EFNM,EFNM,200B 
 FN       ARG    FLNM,FLNM,200B 
 MD       ARG    MDDT,MDDT
 NA       ARG    -NZ,NABT 
 PN       ARG    PKNM,PKNM,400B 
 R        ARG    RES,RES
 TM       ARG    TIME,TIME
 TY       ARG    FLTY,FLTY
 WB       ARG    -NZ,WBSY 
          ARG 
          SPACE  4,10 
*         OPTION TABLES.
  
  
*         FILE CATEGORY OPTIONS.
  
 TFLCT    BSS    0
          VFD    42/0LPRIVATE,18/-FCPR
          VFD    42/0LP,18/-FCPR
          VFD    42/0LPR,18/-FCPR 
          VFD    42/0LSPRIV,18/FCSP 
          VFD    42/0LSP,18/FCSP
          VFD    42/0LS,18/FCSP 
          VFD    42/0LPUBLIC,18/FCPB
          VFD    42/0LPU,18/FCPB
          VFD    42/0LLIBRARY,18/FCLI 
          VFD    42/0LLI,18/FCLI
          VFD    42/0LL,18/FCLI 
          CON    0
          SPACE  4,10 
*         FILE TYPE OPTIONS.
  
 TFLTY    BSS    0
          VFD    42/0LINDIR,18/1
          VFD    42/0LI,18/1
          VFD    42/0LDIRECT,18/2 
          VFD    42/0LD,18/2
          VFD    42/0LALL,18/0
          VFD    42/0LA,18/0
          CON    0
  
  
          END 
