AICD11UT.m

AICD11UT ;IHS/AICD/RNB - Correcting LARGE EINs and BAD 0 Nodes Entries ; 

 ;;3.51;IHS ICD/CPT lookup & grouper;**11**;Nov 08, 1991

 ;

 ; To clean/correct bad entries in ^AUTTCMOD and ^ICPT

 ;    For ^AUTTCMOD:

 ;        LARGE EIN values - need to remove

 ;    

 ;    For ^ICPT:

 ;        Bad/Missing data in invalid ^ICPT(EIN,0) node - missing code or

 ;        (code and short description)

 ;        If bad ^ICPT structure - delete

 ;        If godd structure but missing code or (code and short description) enter

 ;        "unknown" for code and short description

 ;        

 N X,ANS,CODE,ERR,X,Y,DIR

 S X="ERR^AICD12",@^%ZOSF("TRAP")

 S ERR=1

 W !!,$$CJ^XLFSTR("CPT MODIFIER FILE AND CPT FILE CORRECTION UTILITY - BEGIN","")

 ;

 ;Check ^AUTTCMOD for LARGE EIN values

 ;

 W !!,$$CJ^XLFSTR("CPT MODIFIER FILE CHECK - START","")

 W !!,$$CJ^XLFSTR("CPT MODIFIER ENTRIES THAT ARE REMOVED","")

 S AA=9090 F  S AA=$O(^AUTTCMOD(AA)) Q:AA="B"  W !,AA K ^AUTTCMOD(AA)

 W !!,$$CJ^XLFSTR("CPT MODIFIER ENTRIES THAT ARE REMOVED FROM THE 'B' INDEX","")

 S AA="" F  S AA=$O(^AUTTCMOD("B",AA)) Q:AA=""  S BB="" F  S BB=$O(^AUTTCMOD("B",AA,BB)) Q:BB=""  I BB>9090 W !,AA," - ",BB K ^AUTTCMOD("B",AA,BB)

 W !!,$$CJ^XLFSTR("CPT MODIFIER ENTRIES THAT ARE REMOVED FROM THE 'C' INDEX","")

 S AA="" F  S AA=$O(^AUTTCMOD("C",AA)) Q:AA=""  S BB="" F  S BB=$O(^AUTTCMOD("C",AA,BB)) Q:BB=""  I BB>9090 W !,AA," - ",BB K ^AUTTCMOD("C",AA,BB)

 ;

 ; Re-list to see if clean

 W !!,$$CJ^XLFSTR("CPT MODIFIER CHECK 2ND RUN","")

 S AA=9090 F  S AA=$O(^AUTTCMOD(AA)) Q:AA="B"  W !,AA

 ;

 W !!,$$CJ^XLFSTR("CPT MODIFIER FILE CHECK - END","")

 ;

 ; Check ^ICPT for bad zero node entries

 ;

 W !!,$$CJ^XLFSTR("CPT FILE CHECK - START","")

 S AA=0 F  S AA=$O(^ICPT(AA)) Q:(AA="ACT")!(AA="B")  I $P($G(^ICPT(AA,0)),"^",1)="" W !,AA," = ",$G(^ICPT(AA,0)) D PROCS

 W !!,$$CJ^XLFSTR("CPT FILE CHECK - END","")

 W !!,$$CJ^XLFSTR("CPT MODIFIER FILE AND CPT FILE CORRECTION UTILITY - FINISHED","")

 Q

PROCS ;

 ;

 ; Check the indices:

 ;        if none found remove bad entry

 ;        if found entries set code / short description to "unknown"

 ;

 S (GFLG1,GFLG2)=0

 S ZZ="" F  S ZZ=$O(^ICPT("B",ZZ)) Q:ZZ=""  I $D(^ICPT("B",ZZ,AA))=1 S GFLG1=1 Q

 S ZZ="" F  S ZZ=$O(^ICPT("BA",ZZ)) Q:ZZ=""  I $D(^ICPT("BA",ZZ,AA))=1 S GFLG2=1 Q

 I (GFLG1=0)&(GFLG2=0) K ^ICPT(AA) W "  HAS BEEN REMOVED",! Q

 I (GFLG1=1)!(GFLG2=1) S $P(^ICPT(AA,0),"^",1)="unknown",$P(^ICPT(AA,0),"^",2)="unknown" W "  HAS BEEN SET TO - 'unknown'"

 Q

AICD11UT  ;IHS/AICD/RNB - Correcting LARGE EINs and BAD 0 Nodes Entries ; 

 +1       ;;3.51;IHS ICD/CPT lookup & grouper;**11**;Nov 08, 1991

 +2       ;

 +3       ; To clean/correct bad entries in ^AUTTCMOD and ^ICPT

 +4       ;    For ^AUTTCMOD:

 +5       ;        LARGE EIN values - need to remove

 +6       ;    

 +7       ;    For ^ICPT:

 +8       ;        Bad/Missing data in invalid ^ICPT(EIN,0) node - missing code or

 +9       ;        (code and short description)

 +10      ;        If bad ^ICPT structure - delete

 +11      ;        If godd structure but missing code or (code and short description) enter

 +12      ;        "unknown" for code and short description

 +13      ;        

 +14       NEW X,ANS,CODE,ERR,X,Y,DIR

 +15       SET X="ERR^AICD12"

           SET @^%ZOSF("TRAP")

 +16       SET ERR=1

 +17       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER FILE AND CPT FILE CORRECTION UTILITY - BEGIN","")

 +18      ;

 +19      ;Check ^AUTTCMOD for LARGE EIN values

 +20      ;

 +21       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER FILE CHECK - START","")

 +22       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER ENTRIES THAT ARE REMOVED","")

 +23       SET AA=9090

           FOR 

               SET AA=$ORDER(^AUTTCMOD(AA))

               IF AA="B"

                   QUIT 

               WRITE !,AA

               KILL ^AUTTCMOD(AA)

 +24       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER ENTRIES THAT ARE REMOVED FROM THE 'B' INDEX","")

 +25       SET AA=""

           FOR 

               SET AA=$ORDER(^AUTTCMOD("B",AA))

               IF AA=""

                   QUIT 

               SET BB=""

               FOR 

                   SET BB=$ORDER(^AUTTCMOD("B",AA,BB))

                   IF BB=""

                       QUIT 

                   IF BB>9090

                       WRITE !,AA," - ",BB

                       KILL ^AUTTCMOD("B",AA,BB)

 +26       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER ENTRIES THAT ARE REMOVED FROM THE 'C' INDEX","")

 +27       SET AA=""

           FOR 

               SET AA=$ORDER(^AUTTCMOD("C",AA))

               IF AA=""

                   QUIT 

               SET BB=""

               FOR 

                   SET BB=$ORDER(^AUTTCMOD("C",AA,BB))

                   IF BB=""

                       QUIT 

                   IF BB>9090

                       WRITE !,AA," - ",BB

                       KILL ^AUTTCMOD("C",AA,BB)

 +28      ;

 +29      ; Re-list to see if clean

 +30       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER CHECK 2ND RUN","")

 +31       SET AA=9090

           FOR 

               SET AA=$ORDER(^AUTTCMOD(AA))

               IF AA="B"

                   QUIT 

               WRITE !,AA

 +32      ;

 +33       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER FILE CHECK - END","")

 +34      ;

 +35      ; Check ^ICPT for bad zero node entries

 +36      ;

 +37       WRITE !!,$$CJ^XLFSTR("CPT FILE CHECK - START","")

 +38       SET AA=0

           FOR 

               SET AA=$ORDER(^ICPT(AA))

               IF (AA="ACT")!(AA="B")

                   QUIT 

               IF $PIECE($GET(^ICPT(AA,0)),"^",1)=""

                   WRITE !,AA," = ",$GET(^ICPT(AA,0))

                   DO PROCS

 +39       WRITE !!,$$CJ^XLFSTR("CPT FILE CHECK - END","")

 +40       WRITE !!,$$CJ^XLFSTR("CPT MODIFIER FILE AND CPT FILE CORRECTION UTILITY - FINISHED","")

 +41       QUIT 

PROCS     ;

 +1       ;

 +2       ; Check the indices:

 +3       ;        if none found remove bad entry

 +4       ;        if found entries set code / short description to "unknown"

 +5       ;

 +6        SET (GFLG1,GFLG2)=0

 +7        SET ZZ=""

           FOR 

               SET ZZ=$ORDER(^ICPT("B",ZZ))

               IF ZZ=""

                   QUIT 

               IF $DATA(^ICPT("B",ZZ,AA))=1

                   SET GFLG1=1

                   QUIT 

 +8        SET ZZ=""

           FOR 

               SET ZZ=$ORDER(^ICPT("BA",ZZ))

               IF ZZ=""

                   QUIT 

               IF $DATA(^ICPT("BA",ZZ,AA))=1

                   SET GFLG2=1

                   QUIT 

 +9        IF (GFLG1=0)&(GFLG2=0)

               KILL ^ICPT(AA)

               WRITE "  HAS BEEN REMOVED",!

               QUIT 

 +10       IF (GFLG1=1)!(GFLG2=1)

               SET $PIECE(^ICPT(AA,0),"^",1)="unknown"

               SET $PIECE(^ICPT(AA,0),"^",2)="unknown"

               WRITE "  HAS BEEN SET TO - 'unknown'"

 +11       QUIT