*DECK C$ACCDT 
          IDENT  C$ACCDT
          TITLE  CBACCDT- ACCEPT FROM DATE
          MACHINE  ANY,I
          COMMENT  ACCEPT FROM DATE 
          SST 
          B1=1
          SPACE  4
**        CBACCDT- ACCEPT FROM DATE 
* 
*         CALLING SEQUENCE- 
*                RJ   C.ACCDT 
* 
*         INPUT-
*                NONE 
* 
*         OUTPUT- 
*                X1 CONTAINS THE DATE IN THE FORMAT YYMMDD
*                RIGHT-JUSTIFIED AND DISPLAY CODE ZERO FILLED 
* 
*         DOES- 
*                GETS DATE FROM SYSTEM USING DATE MACRO AND 
*                REFORMATS THIS DATE TO ABOVE SPECIFIED ONE 
* 
*         USES- 
*                C.TEMP,C.ZERO
*                B3,B4,B5,A2,X2,X0,X1,X5
* 
          SPACE  4
          ENTRY  C.ACCDT
 C.ACCDT  DATA   0
  
*      IT IS POSSIBLE FOR THE DATE TO BE IN ANY OF THE FOLLOWING FORMS- 
*      YYMMDD, YYDDMM, MMDDYY, MMYYDD, DDYYMM OR DDMMYY 
*      WE MUST BE ABLE TO HANDLE ALL THESE CASES (UNLIKELY THOUGH THEY
*      MAY BE)
*      WE USE IP.YMD TO DECIDE WHICH ORDER IS CHOSEN AND SET OUR SHIFT
*      COUNTS ACCORDINGLY 
  
 A        MICRO  1,1, "IP.YMD"
 B        MICRO  2,1, "IP.YMD"
 C        MICRO  3,1, "IP.YMD"
 "A"      EQU    0
 "B"      EQU    1
 "C"      EQU    2
  
*      NOW WE DEFINE SHIFT COUNTS FOR ALL POSSIBLE CASES- 
*      WE WANT TO EXTRACT YY FIRST MM SECOND AND DD LAST, THUS THE
*      COUNTS WILL BE-
*         B3= COUNT TO RIGHT-JUSTIFY YY FROM DATE RETURNED BY SYSTEM
*             MACRO DATE
*         B4= COUNT TO RIGHT-JUSTIFY MM FROM DATE AFTER ABOVE SHIFT 
*         B5= COUNT TO RIGHT-JUSTIFY DD FROM DATE AFTER ABOVE 2 SHIFTS
          SPACE  4
 M0       IFEQ   M,0         IF MM FIRST
 D1         IFEQ   D,1       IF MM FIRST, DD SECOND 
  
*      MMDDYY CASE           BMM/DD/YYB RETURNED BY DATE MACRO
  
            SB3    54        BBMM/DD/YY AFTER SHIFTING BY B3
            SB4    24        /DD/YYBBMM AFTER SHIFTING BY B4
            SB5    18        /YYBBMM/DD AFTER SHIFTING BY B5
 D1         ENDIF 
  
 Y1         IFEQ   Y,1       IF MM FIRST, DD SECOND 
  
*      MMYYDD CASE           BMM/YY/DDB RETURNED BY DATE MACRO
  
            SB3    36        /DDBBMM/YY AFTER SHIFTING BY B3
            SB4    42        /YY/DDBBMM AFTER SHIFTING BY B4
            SB5    B3        BBMM/YY/DD AFTER SHIFTING BY B5
 Y1         ENDIF 
 M0       ENDIF 
          SPACE  4
 D0       IFEQ   D,0         IF DD FIRST
 M1         IFEQ   M,1       IF DD FIRST, MM SECOND 
  
*      DDMMYY CASE           BDD/MM/YYB RETURNED BY DATE MACRO
  
            SB3  54          BBDD/MM/YY AFTER SHIFTING BY B3
            SB4  42          /YYBBDD/MM AFTER SHIFTING BY B4
            SB5  B4          /MM/YYBBDD AFTER SHIFTING BY B5
 M1         ENDIF 
  
 Y1         IFEQ   Y,1       IF DD FIRST, YY SECOND 
  
*      DDYYMM CASE           BDD/YY/MMB RETURNED BY DATE MACRO
  
            SB3  36          /MMBBDD/YY AFTER SHIFTING BY B3
            SB4  18          BBDD/YY/MM AFTER SHIFTING BY B4
            SB5  24          /YY/MMBBDD AFTER SHIFTING BY B5
 Y1         ENDIF 
 D0       ENDIF 
          SPACE  4
 Y0       IFEQ   Y,0         IF YY FIRST
 M1         IFEQ   M,1       IF YY FIRST, MM SECOND 
  
*      YYMMDD CASE           BYY/MM/DDB RETURNED BY DATE MACRO
  
            SB3    18        /MM/DDBBYY AFTER SHIFTING BY B3
            SB4    B3        /DDBBYY/MM AFTER SHIFTING BY B4
            SB5    B3        BBYY/MM/DD AFTER SHIFTING BY B5
 M1         ENDIF 
  
 D1         IFEQ   D,1       IF YY FIRST, DD SECOND 
  
*      YYDDMM CASE           BYY/DD/MMB RETURNED BY DATE MACRO
  
            SB3    18        /DD/MMBBYY AFTER SHIFTING BY B3
            SB4    36        BBYY/DD/MM AFTER SHIFTING BY B4
            SB5    42        /MMBBYY/DD AFTER SHIFTING BY B5
 D1         ENDIF 
 Y0       ENDIF 
          SPACE  4
          DATE   =XC.TEMP    GET DATE FROM SYSTEM 
          SA2    =XC.TEMP 
          MX0    48 
          LX2    B3,X2       RIGHT-JUSTIFY YY 
          BX1    -X0*X2      YY 
          LX2    B4,X2       RIGHT-JUSTIFY MM 
          LX1    12          SHIFT YY UP TO MAKE ROOM FOR MM
          BX5    -X0*X2      MM 
          LX2    B5,X2       RIGHT-JUSTIFY DD 
          BX1    X5+X1       YYMM 
          BX5    -X0*X2      DD 
          LX1    12          SHIFT YYMM UP TO MAKE ROOM FOR DD
          BX1    X5+X1       YYMMDD 
          SA2    =XC.ZERO    PICK UP WORD OF ZEROS
          MX0    24 
          BX2    X0*X2       MASK OFF LOWER 6 CHARS 
          BX1    X2+X1       APPEND ZEORS TO DATE 
          EQ     C.ACCDT
          END 
