PUNCH 'CATALOG JDATE.OBJ R=Y'
JDATE    START 0
**********************************************************************
* THIS SUBPROGRAM CHANGES A DATE IN THE FORMAT OF YYMMDD TO JULIAN.  *
*                                                                    *
* INPUT:  CL8  YYYYMMDD.                                             *
* OUTPUT: PL4  YYYYDDD. RETURN PACKED ZEROES IF INPUT INVALID.       *
*                                                                    *
* PROGRAMMER: BILL BLASINGIM                                         *
* WRITTEN   : NOVEMBER 8, 1995                                       *
**********************************************************************
         PRINT NOGEN
         SAVE  (14,12)
START    BALR  12,0
         USING *,12
         ST    R13,SAVEAREA+4
         LA    R13,SAVEAREA
         LM    R4,R5,0(1)
*        R4 = ADDRESS OF YYYYMMDD INPUT
*        R5 = ADDRESS OF JULIAN OUTPUT
*
         LR    R6,R4
         LA    R7,8
*        ZAP   YYYY,=P'0'
         ZAP   DAYTOT,=P'0'
CHKNUM   CLI   0(R6),C'0'         CHECK FOR VALID NUMBERS
         BL    BADNUM
         CLI   0(R6),C'9'
         BH    BADNUM
         LA    R6,1(,R6)
         BCT   R7,CHKNUM
CHKDATE  EQU   *
         PACK  MM,4(2,R4)         PACK MONTH
         CVB   R6,MMDBL           CONVERT MONTH TO BINARY
*        MAKE SURE MONTH IS 1-12
         CP    MM,=P'1'
         BL    BADNUM
         CP    MM,=P'12'
         BH    BADNUM
*        CHECK FOR LEAP YEAR
         ZAP   FEB,=P'28'
         CLC   2(2,R4),=CL2'00'
         BNE   NOTCENT
         PACK  YYYY,0(4,R4)
         DP    YYYY,=P'400'
         CP    YYYY+5(2),=P'0'
         BNE   NOTLEAP
NOTCENT  EQU   *
         PACK  YYYY,0(4,R4)
         DP    YYYY,=P'4'
         CP    YYYY+6(1),=P'0'
         BNE   NOTLEAP
         AP    FEB,=P'1'
NOTLEAP  EQU   *
         LA    R7,MONTHDAY
         PACK  DD,6(2,R4)         PACK DAY
         CP    DD,=P'1'           MAKE SURE DAY GREATER THAN ZERO
         BL    BADNUM
         CP    MM,=P'1'
         BE    LOOPEXT
         SH    R6,=H'1'           MONTH LOOP
DAYSUM   EQU   *
         AP    DAYTOT,0(2,R7)
         LA    R7,2(,R7)          NEXT ELEMENT
         BCT   R6,DAYSUM
LOOPEXT  EQU   *
         CP    DD,0(2,R7)         MAKE SURE DAY NOT > MONTHDAY
         BH    BADNUM
         AP    DAYTOT,DD          ADD FINAL DAY
         PACK  YYYY,0(4,R4)
         MP    YYYY,=P'1000'
         AP    YYYY,DAYTOT
         MVC   0(4,R5),YYYY+3
GOBACK   L     R13,SAVEAREA+4
         RETURN (14,12)
BADNUM   EQU   *
         ZAP   0(4,R5),=P'0'
         B     GOBACK
**********************************************************************
*                                                                    *
*                 S T O R A G E   A R E A                            *
*                                                                    *
**********************************************************************
MMDBL    DS   0D        MONTH DOUBLEWORD FOR CVB
         DC   6X'00'
MM       DC   PL2'0'
DD       DC   PL2'0'
YYYY     DS   PL7
DAYTOT   DC   PL7'0'
MONTHDAY DS   0CL24
         DC   P'31'     JANUARY
FEB      DC   P'28'     FEBRUARY
         DC   P'31'     MARCH
         DC   P'30'     APRIL
         DC   P'31'     MAY
         DC   P'30'     JUNE
         DC   P'31'     JULY
         DC   P'31'     AUGUST
         DC   P'30'     SEPTEMBER
         DC   P'31'     OCTOBER
         DC   P'30'     NOVEMBER
         DC   P'31'     DECEMBER
SAVEAREA DS   9D
         REGEQU
         END  START