*
*      THIS IS THE SOURCE CODE
*    OF `SETDATE', A PROGRAM
*    TO BE PLACED IN START.UP BY
*    PTDOS USERS LIKE THE AUTHOR
*    WHO FORGET TO `SET DA=' AND
*    THUS BOTCH UP THEIR ARCHIVES.
*      IT IS ALSO HELPFUL IN
*    BUSINESS APPLICATIONS.
*      IT IS EXPECTED THAT THE PTDOS
*    "SET DD=" COMMAND WILL BE USED
*    ANNUALLY TO SET THE YEAR.
*
*           By Jay Parsons
*   for Somerset Data Systems, Inc.
*
 COPY NPTDEFS   LET PTDOS HELP
 ORG CXBUF      LOAD IN SAFE AREA
 XEQ START      & START THERE
*
START LXI SP,0CC00H SET STACK
AGAIN LXI H,MSG1 POINT TO MSG
 MVI C,30H      FLAG & MARKER
PRINT MOV A,M   GET A CHAR
 CMP C          IS IT 0?
 JZ SETUP       IF SO, MSG DONE
 CALL CONOUT    PRINT CHAR
 INX H          POINT TO NEXT
 JMP PRINT      AND GO ON
SETUP LHLD SYSGLO  GET SYS ADDR
 LXI D,GLDAT    GET DATE OFFSET
 DAD D          ADD THEM
 MOV D,C        SET D FOR BCD
*
* SINCE MOVES DON'T
* AFFECT HARDWARE FLAGS,
* THEY HAVE BEEN PLACED
* BETWEEN THE TEST AND THE
* BRANCH ON IT IN SOME CASES.
*
MONTH CALL PAIR GET THE MONTH
 CPI 13H        WHAT MONTH IS IT?
 JP GOOF        13 BAD, LESS OK
 ANA A           UNLESS IT'S
 JZ GOOF          A ZERO
 MOV M,A        STORE IT
 MOV E,A        BUT SAVE IT
 ORA C          TWO-DIGIT VALUE?
 MOV C,E         <RESET FLAG>
 JM DAY         I  NOT, GET NEXT
 CALL INCHR     IF SO, GET SLASH
 ORA C          IT SHOULD NOT
 JP GOOF        BE A NUMBER
 MOV C,E        RESET FLAG
*
* THE CODE BEYOND THE FOURTH LINE
* BELOW WILL BE REACHED ONLY IF
* DAY>28, IN WHICH CASE MSB
* OF C IS 0 ALREADY.
*
DAY INX H       BUMP POINTER
 CALL PAIR      GET THE DATE
 CPI 29H        28 +?
 JM OKAY        ALL HAVE 28 DAYS
 MOV E,A        SAVE THE DATE
 MOV A,C        GET THE MONTH
 CPI 2          FEBRUARY . . .
 MOV A,E        <GET DATE BACK>
 JZ FEB         . . IS SPECIAL
 INR D          D IS NOW 31H
 CMP D
 JM OKAY        11 HAVE 30 DAYS
 JNZ GOOF       AND NONE 32
*
* IF THIS CODE IS REACHED
* IT MUST BE THE 31ST
*
 MOV A,C        GET THE MONTH
 RRC            EVEN OR ODD?
 CPI 84H
 JP GOOF        ODD MONTHS <8 OK
 CPI 04H
 JM GOOF        EVENS >7 OK
 MOV A,E        GET DATE BACK
 JMP OKAY
*
*  THIS CODE WILL BE REACHED
*  ONLY FOR INPUTS OF DATES
*  IN FEBRUARY OF 29 OR MORE
*
FEB CMP D       FEB 30TH OR MORE?
 JP GOOF           CAN'T BE.
 INX H          BUMP POINTER AND
 MOV A,M        FETCH THE YEAR
 DCX H          AND RESET POINTER
 RRC .          LEAP YEARS (TO 2099)
 JC GOOF        DIVIDE BY 2--AND
 ANI 9          THEN BITS 0 AND 3
 JPO GOOF       SHOULD BE ALIKE
 MOV A,E        GET DATE BACK
*
OKAY ANA A      MIGHT STILL BE
 JZ GOOF           ZERO
 MOV M,A        IF NOT WE'RE DONE
 MVI A,10       LINE FEED
 CALL CONOUT
 CALL SYS       TIME TO
 DB RETOP       GO HOME
*
PAIR CALL INCHR    1ST CHAR
 MOV E,B           SAVE IT
 ORA C          IS IT NUMBER?
 JM GOOFY       1ST SHOULD BE.
 CALL INCHR        2ND CHAR
 ORA C          IF 2ND NO NUMBER
 MOV A,E        FETCH 1ST BACK
 RM .           AND RET WITH IT
 RLC .
 RLC .          IF BOTH ARE NUMBERS
 RLC .          PUT 1ST INTO HIGH
 RLC .            FOUR BITS
 ORA B          MERGE WITH 2ND
 RET            AND WE HAVE IT
*
* BINARY VALUE OF CHARACTER
* WILL RETURN IN B.
*
INCHR CALL CONIN  GET THE CHAR
 CALL CONOUT    PRINT IT
 SUB D          CONVERT TO BINARY
 MOV B,A        SAVE IT
 JM NONUM       TOO SMALL
 CPI 10
 RM .           NOT TOO BIG
*
* MSB OF C TO BE 0 IF NUMBER,
*    1 IF NOT NUMBER
*
NONUM MOV A,C   SET FLAG
 ORI 80H
 MOV C,A
 RET
*
GOOFY INX SP    ADJUST STACK
 INX SP
GOOF MVI A,10   DO A LINE FEED
 CALL CONOUT
 LXI H,-1       ONE LINE MSG
 MVI A,0F0H     CONTROL WORD
 CALL UTIL
 DB UXOP        XPLAIN UTIL
 JMP 0BCB0H     SRESET ON ERROR
 DB -1          NO OP MSG
 DB ERIVA       ILLEGAL VALUE
 MVI A,10       ANOTHER LINE FEED
 CALL CONOUT
 JMP AGAIN      AND TRY AGAIN
*
MSG1 ASC "Please enter today's "
 ASC "month and date in "
 ASC "figures (M/D): "
 ASC "0"