
                     * PAG
                     *****************************************************
                     * DATE - SET AND EXAMINE DATE UTILITY               *
                     *****************************************************
                     * OPT PAG
                     *
                     * 'DATE' COPYRIGHT (C) 1978 BY
                     *
                     * TECHNICAL SYSTEMS CONSULTANTS, INC.
                     * P.O. BOX 2574
                     * WEST LAFAYETTE, INDIANA 47906
                     * (317) 423-5465
                     *
                     
                     * BY FLD ON 15-10-2011 FOR VEGAS
                     
                     * GLOBAL VARIABLES
                     
               CC02  EOL     EQU    $CC02
               C840  FCB     EQU    $C840
               CC0E  DATE    EQU    $CC0E
               CC11  LSTTRM  EQU    $CC11
               D403  FMSCLS  EQU    $D403
               D406  FMS     EQU    $D406
               CD03  WARMS   EQU    $CD03
               CD15  GETCHR  EQU    $CD15
               CD18  PUTCHR  EQU    $CD18
               CD1E  PSTRNG  EQU    $CD1E
               CD24  PCRLF   EQU    $CD24
               CD39  OUTDEC  EQU    $CD39
               CD3F  RPTERR  EQU    $CD3F
               CD48  INDEC   EQU    $CD48
                     
  C100                       ORG    $C100
                     
  C100 20   03       DATE0   BRA    DATE1     SKIP VERSION NUMBER
                     
  C102 01            VN      FCB    1         VERSION NUMBER
  C103 0000          VALUE   FDB    0
                     
  C105 B6   CC11     DATE1   LDAA   LSTTRM    CHECK TERM CHAR
  C108 81   0D               CMPA   #$D       IS IT CR?
  C10A 27   4A               BEQ    PDAT
  C10C B1   CC02             CMPA   EOL       IS IT EOL?
  C10F 27   45               BEQ    PDAT
  C111 8D   2F               BSR    GETDAT    INPUT NUMBER
  C113 25   20               BCS    DATE4     ERROR?
  C115 81   0C               CMPA   #12       GREATER THAN 12?
  C117 22   1C               BHI    DATE4
  C119 B7   CC0E             STAA   DATE      SAVE MONTH
  C11C 8D   24               BSR    GETDAT    GET DAY NUMBER
  C11E 25   15               BCS    DATE4     ERROR?
  C120 81   1F               CMPA   #31       GREATER THAN 31?
  C122 22   11               BHI    DATE4
  C124 B7   CC0F             STAA   DATE+1    SAVE DAY
  C127 8D   19               BSR    GETDAT    GET YEAR NUMBER
  C129 25   0A               BCS    DATE4     ERROR?
  C12B 81   63               CMPA   #99       GREATER THAN 99?
  C12D 22   06               BHI    DATE4
  C12F B7   CC10             STAA   DATE+2    SAVE YEAR
  C132 7E   CD03             JMP    WARMS     RETURN TO FLEX
                     
  C135 8E   C840     DATE4   LDX    #FCB      POINT TO FCB
  C138 C6   1A               LDAB   #26       SET UP ERROR NUMBER
  C13A E7   01               STAB   1,X       STUFF IN FCB
  C13C BD   CD3F             JSR    RPTERR    REPORT ERROR
  C13F 7E   CD03             JMP    WARMS     RETURN TO FLEX
                     
                     * INPUT DATE DIGIT
                     
  C142 BD   CD48     GETDAT  JSR    INDEC     INPUT NUMBER
  C145 25   0E               BCS    GETDA4    ERROR?
  C147 5D                    TSTB             NUMBER THERE?
  C148 27   09               BEQ    GETDA3
  C14A BF   C103             STX    VALUE     SAVE VALUE
  C14D B6   C104             LDAA   VALUE+1   GET LS PART
  C150 1C   FE               CLC              CLEAR ERRORS
  C152 39                    RTS
  C153 1A   01       GETDA3  SEC              SET ERRORS
  C155 39            GETDA4  RTS
                     
                     * PRINT DATE
                     
  C156 BD   CD24     PDAT    JSR    PCRLF     OUTPUT CR & LF
  C159 B6   CC0E             LDAA   DATE      GET MONTH
  C15C 8E   C1A9             LDX    #MONTH    POINT TO TABLE
  C15F 4A            PDAT1   DECA             CHECK DATE
  C160 27   0A               BEQ    PDAT3
  C162 30   01       PDAT2   INX              FIND MONTH STRING
  C164 6D   84               TST    0,X
  C166 26   FA               BNE    PDAT2
  C168 30   01               INX
  C16A 20   F3               BRA    PDAT1
  C16C 8D   2A       PDAT3   BSR    PST       GO PRINT IT
  C16E 86   20               LDAA   #$20      OUTPUT SPACE
  C170 BD   CD18             JSR    PUTCHR
  C173 7F   C103             CLR    VALUE
  C176 B6   CC0F             LDAA   DATE+1    GET DAY NUMBER
  C179 B7   C104             STAA   VALUE+1
  C17C 8E   C103             LDX    #VALUE    POINT TO IT
  C17F 5F                    CLRB             CLEAR FLAG
  C180 BD   CD39             JSR    OUTDEC    PRINT DAY
  C183 8E   C1A4             LDX    #CST      POINT TO STRING
  C186 8D   10               BSR    PST       PRINT IT
  C188 B6   CC10             LDAA   DATE+2    GET YEAR
  C18B B7   C104             STAA   VALUE+1
  C18E 5F                    CLRB
  C18F 8E   C103             LDX    #VALUE    POINT TO VALUE
  C192 BD   CD39             JSR    OUTDEC    PRINT YEAR
  C195 7E   CD03             JMP    WARMS     RETURN TO FLEX
                     
                     * PRINT STRING
                     
  C198 A6   84       PST     LDAA   0,X       GET CHARACTER
  C19A 27   07               BEQ    PST2      IS IT NULL?
  C19C BD   CD18             JSR    PUTCHR    OUTPUT CHARACTER
  C19F 30   01               INX              BUMP TO NEXT
  C1A1 20   F5               BRA    PST       REPEAT
  C1A3 39            PST2    RTS
                     
                     * TEXT STRINGS
                     
  C1A4 2C 20 31 39   CST     FCC    ", 19"
  C1A8 00                    FCB    0
                     
                     * MONTH STRINGS
                     
  C1A9 4A 41 4E 56   MONTH   FCC    'JANVIER'
  C1AD 49 45 52      
  C1B0 00                    FCB    0
  C1B1 46 45 56 52           FCC    'FEVRIER'
  C1B5 49 45 52      
  C1B8 00                    FCB    0
  C1B9 4D 41 52 53           FCC    'MARS'
  C1BD 00                    FCB    0
  C1BE 41 56 52 49           FCC    'AVRIL'
  C1C2 4C            
  C1C3 00                    FCB    0
  C1C4 4D 41 49              FCC    'MAI'
  C1C7 00                    FCB    0
  C1C8 4A 55 49 4E           FCC    'JUIN'
  C1CC 00                    FCB    0
  C1CD 4A 55 49 4C           FCC    'JUILLET'
  C1D1 4C 45 54      
  C1D4 00                    FCB    0
  C1D5 41 4F 55 54           FCC    'AOUT'
  C1D9 00                    FCB    0
  C1DA 53 45 50 54           FCC    'SEPTEMBRE'
  C1DE 45 4D 42 52   
  C1E2 45            
  C1E3 00                    FCB    0
  C1E4 4F 43 54 4F           FCC    'OCTOBRE'
  C1E8 42 52 45      
  C1EB 00                    FCB    0
  C1EC 4E 4F 56 45           FCC    'NOVEMBRE'
  C1F0 4D 42 52 45   
  C1F4 00                    FCB    0
  C1F5 44 45 43 45           FCC    'DECEMBRE'
  C1F9 4D 42 52 45   
  C1FD 00                    FCB    0
                     
                             END    DATE0

0 ERROR(S) DETECTED

SYMBOL TABLE:

CST    C1A4   DATE   CC0E   DATE0  C100   DATE1  C105   DATE4  C135   
EOL    CC02   FCB    C840   FMS    D406   FMSCLS D403   GETCHR CD15   
GETDA3 C153   GETDA4 C155   GETDAT C142   INDEC  CD48   LSTTRM CC11   
MONTH  C1A9   OUTDEC CD39   PCRLF  CD24   PDAT   C156   PDAT1  C15F   
PDAT2  C162   PDAT3  C16C   PST    C198   PST2   C1A3   PSTRNG CD1E   
PUTCHR CD18   RPTERR CD3F   VALUE  C103   VN     C102   WARMS  CD03   





