AICDZMDC.m

AICDZMDC ;IHS/OIT/FBD - CLEAN UP MDC PTRS IN ICD FILES

 ;;4.0;AICD;;DEC 03, 2014;Build 7

 ;

 ;UTILITY TO CLEAN UP MALFORMED 'MAJOR DIAGNOSTIC CATEGORY' POINTER FIELD

 ;VALUES IN THE ICD DIAGNOSIS (#80) AND ICD OPERATION/PROCEDURE (#80.1)

 ;FILES.

 ;

 D INIT

 D MAIN

 D CLEANUP

 Q

 ;

INIT ;PRIMARY MODULE INITIALIZATION

 S U="^"

 K ^AICDZMDC  ;TEMP COPY OF CLEANED ENTRIES

 Q

 ;

MAIN ;PRIMARY MODULE EXECUTION

 D ICDDX

 D ICDPX

 W:'$D(ZTSK) !,"# OF ENTRIES CLEANED - FILE 80:   ",^AICDZMDC("ICD9")

 W:'$D(ZTSK) !,"# OF ENTRIES CLEANED - FILE 80.1: ",^AICDZMDC("ICD0")

 Q

 ;

ICDDX ;CLEAN UP FILE 80 (ICD DIAGNOSIS)

 S (AICDIEN,AICDCNT)=0

 F  S AICDIEN=$O(^ICD9(AICDIEN)) Q:AICDIEN'=+AICDIEN  D  ;

 . S AICDMDC=$P(^ICD9(AICDIEN,0),U,5)  ;EXTRACT MDC PTR

 . Q:AICDMDC=""  ;SKIP IF NULL,

 . Q:AICDMDC=+AICDMDC  ;SKIP IF A TRUE NUMBER,

 . S AICDCNT=AICDCNT+1,^AICDZMDC("ICD9",AICDIEN)=AICDMDC  ;ELSE COUNT & RECORD THE ERROR,

 . S $P(^ICD9(AICDIEN,0),U,5)=+AICDMDC  ;THEN CLEAN UP THE ENTRY

 S ^AICDZMDC("ICD9")=AICDCNT  ;COUNT OF CLEANED ENTRIES

 Q

 ;

ICDPX ;CLEAN UP FILE 80.1 (ICD OPERATION/PROCEDURE)

 S (AICDIEN,AICDCNT)=0

 F  S AICDIEN=$O(^ICD0(AICDIEN)) Q:AICDIEN'=+AICDIEN  D  ;

 . S AICDMLT=0  ;IEN WITHIN 'MDC' MULTIPLE

 . F  S AICDMLT=$O(^ICD0(AICDIEN,"MDC",AICDMLT)) Q:AICDMLT'=+AICDMLT  D  ;

 .. S AICDMDC=$P(^ICD0(AICDIEN,"MDC",AICDMLT,0),U,1)  ;EXTRACT MDC PTR

 .. Q:AICDMDC=""  ;SKIP IF NULL,

 .. Q:AICDMDC=+AICDMDC  ;SKIP IF A TRUE NUMBER,

 .. S AICDCNT=AICDCNT+1,^AICDZMDC("ICD0",AICDIEN,AICDMLT)=AICDMDC  ;ELSE COUNT & RECORD THE ERROR,

 .. S $P(^ICD0(AICDIEN,"MDC",AICDMLT,0),U,1)=+AICDMDC  ;THEN CLEAN UP THE ENTRY

 S ^AICDZMDC("ICD0")=AICDCNT  ;COUNT OF CLEANED ENTRIES

 Q

 ;

CLEANUP ;PRIMARY MODULE CLEANUP

 Q

AICDZMDC  ;IHS/OIT/FBD - CLEAN UP MDC PTRS IN ICD FILES

 +1       ;;4.0;AICD;;DEC 03, 2014;Build 7

 +2       ;

 +3       ;UTILITY TO CLEAN UP MALFORMED 'MAJOR DIAGNOSTIC CATEGORY' POINTER FIELD

 +4       ;VALUES IN THE ICD DIAGNOSIS (#80) AND ICD OPERATION/PROCEDURE (#80.1)

 +5       ;FILES.

 +6       ;

 +7        DO INIT

 +8        DO MAIN

 +9        DO CLEANUP

 +10       QUIT 

 +11      ;

INIT      ;PRIMARY MODULE INITIALIZATION

 +1        SET U="^"

 +2       ;TEMP COPY OF CLEANED ENTRIES

           KILL ^AICDZMDC

 +3        QUIT 

 +4       ;

MAIN      ;PRIMARY MODULE EXECUTION

 +1        DO ICDDX

 +2        DO ICDPX

 +3        IF '$DATA(ZTSK)

               WRITE !,"# OF ENTRIES CLEANED - FILE 80:   ",^AICDZMDC("ICD9")

 +4        IF '$DATA(ZTSK)

               WRITE !,"# OF ENTRIES CLEANED - FILE 80.1: ",^AICDZMDC("ICD0")

 +5        QUIT 

 +6       ;

ICDDX     ;CLEAN UP FILE 80 (ICD DIAGNOSIS)

 +1        SET (AICDIEN,AICDCNT)=0

 +2       ;

           FOR 

               SET AICDIEN=$ORDER(^ICD9(AICDIEN))

               IF AICDIEN'=+AICDIEN

                   QUIT 

               Begin DoDot:1

 +3       ;EXTRACT MDC PTR

                   SET AICDMDC=$PIECE(^ICD9(AICDIEN,0),U,5)

 +4       ;SKIP IF NULL,

                   IF AICDMDC=""

                       QUIT 

 +5       ;SKIP IF A TRUE NUMBER,

                   IF AICDMDC=+AICDMDC

                       QUIT 

 +6       ;ELSE COUNT & RECORD THE ERROR,

                   SET AICDCNT=AICDCNT+1

                   SET ^AICDZMDC("ICD9",AICDIEN)=AICDMDC

 +7       ;THEN CLEAN UP THE ENTRY

                   SET $PIECE(^ICD9(AICDIEN,0),U,5)=+AICDMDC

               End DoDot:1

 +8       ;COUNT OF CLEANED ENTRIES

           SET ^AICDZMDC("ICD9")=AICDCNT

 +9        QUIT 

 +10      ;

ICDPX     ;CLEAN UP FILE 80.1 (ICD OPERATION/PROCEDURE)

 +1        SET (AICDIEN,AICDCNT)=0

 +2       ;

           FOR 

               SET AICDIEN=$ORDER(^ICD0(AICDIEN))

               IF AICDIEN'=+AICDIEN

                   QUIT 

               Begin DoDot:1

 +3       ;IEN WITHIN 'MDC' MULTIPLE

                   SET AICDMLT=0

 +4       ;

                   FOR 

                       SET AICDMLT=$ORDER(^ICD0(AICDIEN,"MDC",AICDMLT))

                       IF AICDMLT'=+AICDMLT

                           QUIT 

                       Begin DoDot:2

 +5       ;EXTRACT MDC PTR

                           SET AICDMDC=$PIECE(^ICD0(AICDIEN,"MDC",AICDMLT,0),U,1)

 +6       ;SKIP IF NULL,

                           IF AICDMDC=""

                               QUIT 

 +7       ;SKIP IF A TRUE NUMBER,

                           IF AICDMDC=+AICDMDC

                               QUIT 

 +8       ;ELSE COUNT & RECORD THE ERROR,

                           SET AICDCNT=AICDCNT+1

                           SET ^AICDZMDC("ICD0",AICDIEN,AICDMLT)=AICDMDC

 +9       ;THEN CLEAN UP THE ENTRY

                           SET $PIECE(^ICD0(AICDIEN,"MDC",AICDMLT,0),U,1)=+AICDMDC

                       End DoDot:2

               End DoDot:1

 +10      ;COUNT OF CLEANED ENTRIES

           SET ^AICDZMDC("ICD0")=AICDCNT

 +11       QUIT 

 +12      ;

CLEANUP   ;PRIMARY MODULE CLEANUP

 +1        QUIT