//      JOB 
//
//                  JCL if needed
//
//*
//IN1 DD DSN=file with mapping of icd9 to PIPDCG, fmtxwalk.txt here 
//*
//SYSIN DD *
 /**********************************************************************
*             DATE: 01/13/1999
*          PROGRAM: Program that creates a SAS format, fmtprog.txt here
*      DESCRIPTION: THIS PROGRAM CREATES THE FOLLOWING FORMATS:
*                     - 3 FORMATS TO GO FROM ICD9 TO PIPDXGS,
*                     - FORMAT TO GO FROM PIPDXG TO PIPDCG,
*                   THE OUTPUT FILE IS A FORMAT LIBRARY.
*
***********************************************************************/;
***********************************************************************
* STEP1: allocate new format library.                                 *
***********************************************************************;
  LIBNAME LIBRARY
         'File that contains SAS formats'
          DISP=NEW   UNIT=   ;
  LIBNAME LIBRARY LIST;

***********************************************************************
* STEP2: read in a text cross-walk from ICD9 into PIPDXG and PIPDCG   *
***********************************************************************;

   DATA  DCG20;
      INFILE IN1 TRUNCOVER;
      INPUT
          @1   ICD9       $CHAR5.
          @7   PIPDXG     $CHAR3.
          @11  PIPDCG     2.;

   RUN;
   PROC PRINT U DATA=DCG20(OBS=30);
        TITLE '*** INPUT FILE ***';
   RUN;

***********************************************************************
* STEP3: create   data for mapping from 3, 4 and 5 digit diag code    *
* into pipdxg groups.                                                 *
***********************************************************************;

  DATA TEMP1(KEEP=DIAG3 DIAG4 DIAG5  PIPDXG);
       SET  DCG20(KEEP=ICD9  PIPDXG);
       LENGTH DIAG3 $3  DIAG4 $4  DIAG5 $5;
       DIAG3=SUBSTR(ICD9,1,3);
       DIAG4=SUBSTR(ICD9,1,4);
       DIAG5=SUBSTR(ICD9,1,5);
  RUN;

  PROC SORT DATA=TEMP1;
       BY DIAG3 DIAG4 DIAG5;
  RUN;

  DATA THREE(KEEP = DIAG3  PIPDXG3)
       FOUR (KEEP = DIAG4  PIPDXG4)
       FIVE (KEEP = DIAG5  PIPDXG5);
       SET  TEMP1;
       BY DIAG3 DIAG4 DIAG5;
       LENGTH PIPDXG3 $3 PIPDXG4 $3 PIPDXG5 $3;

       PIPDXG3='SPL';

       IF FIRST.DIAG3 AND LAST.DIAG3 THEN DO;
            PIPDXG3 = PIPDXG;
       END;

       IF LAST.DIAG3 THEN OUTPUT THREE;
       IF PIPDXG3 = 'SPL' THEN DO;
         /* this section should only be reached when there is more */
         /* than one four or five digit codes.                     */;
         PIPDXG4 = 'SPL';
         IF FIRST.DIAG4 AND LAST.DIAG4 THEN DO;
            PIPDXG4 = PIPDXG;
         END;
         IF LAST.DIAG4 THEN OUTPUT FOUR;

         IF PIPDXG4 = 'SPL' THEN DO;

           /* this section should only be reached when there is more */
           /*  five digit codes.                                     */;
            PIPDXG5 = PIPDXG;
            OUTPUT FIVE;
         END;
       END;

    RUN;
***********************************************************************
* STEP4: create data for mapping from 3 digit diag code into pipdxg   *
* group.                                                              *
***********************************************************************;

   DATA TEMP3A(RENAME=(DIAG3=START  PIPDXG3=LABEL));
        SET THREE;
        FMTNAME='$PDXG3F';
   RUN;

   PROC PRINT DATA=TEMP3A(OBS=46);
        TITLE '*** 3 DIGIT FORMAT ***';
   RUN;
***********************************************************************
* STEP5: create data for mapping from 4 digit diag code into pipdxg   *
* group.                                                              *
***********************************************************************;

   DATA TEMP4A(RENAME=(DIAG4=START  PIPDXG4=LABEL));
        SET FOUR;
        FMTNAME='$PDXG4F';
   RUN;

   PROC PRINT DATA=TEMP4A(OBS=46);
        TITLE '*** 4 DIGIT FORMAT ***';
   RUN;

***********************************************************************
* STEP6: create data for mapping from 5 digit diag code into pipdxg   *
* group.                                                              *
***********************************************************************;

 DATA TEMP5A(RENAME=(DIAG5=START  PIPDXG5=LABEL));
      SET FIVE;
      FMTNAME='$PDXG5F';
 RUN;

 PROC PRINT DATA=TEMP5A(OBS=100);

***********************************************************************
* STEP7: add dxgroup formats to format library on disk                *
***********************************************************************;

 PROC FORMAT CNTLIN=TEMP3A      LIBRARY=LIBRARY;
 RUN;

 PROC FORMAT CNTLIN=TEMP4A      LIBRARY=LIBRARY;
 RUN;

 PROC FORMAT CNTLIN=TEMP5A      LIBRARY=LIBRARY;
 RUN;
***********************************************************************
* STEP8: format for mapping pipdxg into pipdcg                        *
***********************************************************************;

  PROC SORT NODUPKEY DATA=DCG20(KEEP=PIPDXG PIPDCG)
       OUT=TEMPC1;
       BY PIPDXG;
  RUN;
  DATA TEMPC2;
       SET TEMPC1;
       RENAME PIPDXG=START
              PIPDCG=LABEL;
       FMTNAME='$DCGDXGE';
  RUN;

  PROC FORMAT CNTLIN=TEMPC2     LIBRARY=LIBRARY;
  RUN;

  PROC PRINT U DATA=TEMPC2(OBS=46);
       TITLE '*** DATA TO CREATE XWALK FROM PIPDXG INTO PIPDCG ***';
  RUN;

 