PUNCH 'CATALOG JDATE2.OBJ R=Y'
JDATE2   START 0
**********************************************************************
* THIS SUBPROGRAM CHANGES A DATE IN THE JULIAN FORMAT YYYYDDD TO     *
* YYYYMMDD.                                                          *
*                                                                    *
* INPUT:  CL7  YYYYDDD.                                              *
* OUTPUT: CL8  YYYYMMDD. RETURN ZEROES IF INPUT IS 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 JULIAN INPUT
*        R5 = ADDRESS OF YYMMDD OUTPUT
*
         LR    R6,R4
         LA    R7,7               CHECK YYYYDDD
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
         PACK  DDD,4(3,R4)        PACK TOTAL DAYS
         CP    DDD,=P'366'
         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   *
CHKDATE  EQU   *
         LA    R6,MONTHDAY
         ZAP   MM,=P'1'
LOOP     EQU   *
         CP    DDD,0(2,R6)
         BNH   LOOPEXIT
         SP    DDD,0(2,R6)
         AP    MM,=P'1'
         CP    MM,=P'12'
         BH    BADNUM
         LA    R6,2(,R6)          NEXT MONTHS TOTAL DAYS
         B     LOOP
LOOPEXIT EQU   *
*        PDUMP YY,FEB
         MVC   0(4,R5),0(R4)      YEAR
         UNPK  4(2,R5),MM         UNPACK MONTH
         OI    5(R5),X'F0'        FIX SIGN
         UNPK  6(2,R5),DDD         UNPACK DAY
         OI    7(R5),X'F0'        FIX SIGN
GOBACK   L     R13,SAVEAREA+4
         RETURN (14,12)
BADNUM   EQU   *
         MVI   0(R5),C'0'
         MVC   1(7,R5),0(R5)
         B     GOBACK
**********************************************************************
*                                                                    *
*                 S T O R A G E   A R E A                            *
*                                                                    *
**********************************************************************
         DS   0D
YYYY     DC   PL7'0'
MM       DC   PL2'0'
DDD      DC   PL2'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